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ABSTRACT 



As part of developing the Execution Support System of Computer-Aided Prototyping 
System (CAPS), there is a need to translate and schedule prototypes of hard real-time 
systems whose specifications are defined in a hierarchical structure by using the 
Prototyping System Description Language (PSDL). We present a design and 
implementation of a PSDL expander in this thesis. The expander translates a PSDL 
prototype with an arbitrarily deep hierarchical structure into an equivalent two-level form 
that can be processed by the current implementations of the other CAPS tools. The design 
of the expander also provides for inheritance of timing constraints and static consistency 
checking. 

To establish a convenient representation of PSDL specifications, we define an 
Abstract Data Type (ADT) that provides an Ada representation of PSDL specification. The 
main idea behind the PSDL ADT is forming an abstract representation of PSDL to support 
software tools for analyzing, constructing, and translating PSDL programs. The PSDL 
ADT is built by using other common abstract data types, i.e. maps, sets, sequences, graphs, 
and stacks. The construction process of ADT itself is done by SinLALR(l) parser, generated 
in Ada using the tools AYACC and AFLEX, a parser generator and a lexical analyzer. 
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THESIS DISCLAIMER 

The reader is cautioned that computer programs developed in this research may not 
have been tested for all cases of interest. While every effort has been made within the time 
available to ensure that the programs are free of computational and logic errors, they 
cannot be considered validated. Any application of these programs without additional 
verification is at the risk of the user. 
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I. INTRODUCTION 



Conceptual simplicity, tight coupling of tools, and effective support of host-target software 

development will characterize advanced Ada* programming environments. The demand for 
large, high quality systems has increased to the point where a jump in software technology is 
needed. Computer aided, rapid prototyping via specification and reusable components is one of 
the most promising solutions to tins approach. A working model of such an environment is the 
Computer-Aided Prototyping System (CAPS), which supports rapid prototyping based on 
abstractions and reusable software components [Ref. 1]. CAPS has been built to help software 
engineers rapidly construct software prototypes of proposed software systems. It provides a 
methodology for constructing complex hard real-time prototypes from a data-flow graph of 
inter-task communications specified through a Prototyping System Description Language 
(PSDL). 

As part of developing the Execution Support System of the Computer-Aided 
Prototyping System, there is a need to translate and schedule prototypes of hard real-time 
systems whose specifications are defined in a hierarchical structure by using Prototyping 
Description Language (PSDL). We present a design and implementation of a PSDL 
expander in this thesis. The expander translates a PSDL prototype with an arbitrarily 
depth hierarchical structure into an equivalent two-level form that can be processed by the 
current implementations of the other CAPS tools. The design of the expander also provides 
for inheritance of timing constraints and static consistency checking. 

A. STATEMENT OF THE PROBLEM 

PSDL is a partially-graphical language for specification and design of real-time systems. 
A PSDL prototype consists of a hierarchically structured collection of definitions for operators 
and types. Luqi et al. [Ref. 2] mention one of the requirements of the design of PSDL as: 
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“PSDL should support hierarcliically structured prototypes, to simplify prototyping 

of large and complex systems. The PSDL descriptions at all levels of the designed 

prototype should be uniform.” 

The current implementation of Execution Support System within CAPS is limited to 
hierarchically structured PSDL specifications with, at most, two levels. There is a need for an 
expander that will expand hierarchical PSDL specifications with arbitrary depth into a two 
level specification. 

Timing constraints are an essential part of specifying real-time systems [Ref 2]. In PSDL, 
timing constraints impose some constraints between the various levels of a hierarchical 
specification. Tlie current implementation of CAPS does not guarantee that these constraints 
are met, and there is a need for consistency checking to pinpoint possible inconsistencies in the 
timing constraints between various levels. This thesis presents a partial design for such a 
consistency checker. 

B. SCOPE 

The design and implementation of an expander that will expand the hierarchical PSDL 
specifications with arbitrary depth into a two-level specification is the focus of this thesis. 

The expander will also check the inconsistencies in the real-time constraints between the 
various levels of hierarcliically structured PSDL specification during the expandion process. 

C. RESEARCH APPROACH 

To establish a convenient representation of PSDL specifications, we define an 
Abstract Data Type (ADT) that provides an Ada representation of PSDL specification. The 
main idea behind the PSDL ADT is forming an abstract representation of PSDL to support 
software tools for analyzing, constructing, and translating PSDL programs. The PSDL 
ADT is built by using other common abstract data types, i.e. maps, sets, sequences, graphs, 
and stacks. The construction process of ADT itself is done by an LALR(l)^ parser, generated 
in Ada using the tools AYACC and AFLEX, a parser generator and a lexical analyzer. These 



^ LALR (Look Ahead Left 



Recursive) parser is one of the commonly used parsers. 
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tools have been developed at University of California Irvine as part of the Arcadia Project [Ref. 
3 , 4 ]. 

By processing the generated PSDL ADT for an input PSDL program, we transform the 
hierarchical structure into a two level specification, which we refer to as the expanded 
specification. The resulting expanded PSDL program is written into a new file to be processed 
by the tools in the Execution Support System. 

During the expansion process of PSDL program, consistency of the timing constraints 
between various levels should also be checked and error messages produced as appropriate. 

D. ORGANIZATION 

Chapter II. provides a brief background on traditional software development 
methodology, development of real-time systems, and rapid prototyping methodology. It also 
gives an overview of the CAPS environment, its specification language PSDL, and the tools 
within CAPS. Chapter III. presents the design, and Chapter IV. presents implementation of 
the PSDL ADT and expander. Chapter V. provides the conclusions and recommendations for 
further research to enhance the functionality of the current design. 
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II. BACKGROUND 



A SOFTWARE DEVELOPMENT 

The United States Department of Defense (DoD) is currently the world’s largest user of 
computers. Each year billions of dollars are allocated for the development and maintenance of 
progressively more complex weapons and communications systems. These systems 
increasingly rely on information processing, utilizing embedded computer systems. These 
systems are often characterized by time periods or deadlines within which some event must 
occur. These are known as “hard real-time constraints”. Satellite control systems, missile 
guidance systems and communications networks are examples of embedded systems with hard 
real-time constraints. Correctness and reliability of these software systems is critical. Software 
development of these systems is an immense task with increasingly high costs and potential 
for mis-development [Ref. 5]. 

Over the past twenty years, the technological advances in computer hardware technology 
have reduced the hardware costs of a total system from 85 percent to about 15 percent. In the 
early 1970s, studies showed that computer software alone comprised approximately 46 percent 
of the estimated total DoD computer costs. Of this cost, 56 percent was devoted specifically to 
embedded systems. In spite of the tremendous costs, most large software systems were 
characterized as not providing the functionality that was desired, took too long to build, cost 
too much time or space to use, and could not evolve to meet the user’s changing needs [Ref 5]. 

Software engineering evolved in response to the need to design, implement, test, install 
and maintain more efficiently and correctly larger and more complex software systems. The 
term software engineering was coined in 1967 by a NATO study group, and endorsed by the 
1968 NATO Software Engineering Conference [Ref. 6]. The conference concluded that software 
engineering should use the philosophies and paradigms of traditional engineering disciplines. 
Numerous methodologies have been introduced to support software engineering. The major 
approaches which underlie these different methodologies are the waterfall model [Ref. 7] of 
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development with its variants such as the spiral model [Ref. 8], and the prototyping [Ref. 9] 
method of development. 

1. The Classical Project Life Cycle: Waterfall Model 

The waterfall model describes a sequential approach to software development as 
shown in Figure 2.1. Tlie requirements are completely determined before the system is 
designed, implemented and tested. The cost of systems developed using this model is very high. 
Required modifications which are realized late in the development of a system, such as during 
the testing phase, have a much greater impact on the cost of the system than they would have 
if they had been determined during the requirements analysis stage of the development. 
Requirements analysis may be considered the most critical stage of software development since 
this is when the system is defined [Ref 10]. 




Requirements are often incompletely or erroneously specified due to the often vast 
difference in the technical backgrounds of the user and the analyst. It is often the case that the 
user understands liis application area but does not have the technical background to 
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communicate successfully his needs to the analyst, while the analyst is not familiar enough 
with the application to detect a misunderstanding between himself and the user. The 
successful development of a software system is strictly dependent upon tliis process. The 
analyst must understand the needs and desires of the user and the performance constraints of 
the intended software system in order to specify a complete and correct software system. 
Requirements specifications are still most widely written using the English language, which is 
an ambiguous and non-specific mode of communication. 

Another difficulty of the classical life cycle is that communication between a software 
development team and the customer or the system’s users is weak. Most of the time the 
customer does not what he/she wants. In that case it is hard to determine the exact 
requirements, since the software development is also unfamiliar with the problem domain of 
the system. Formal specification languages are used to formalize the customer needs to a 
certain extent. Another disadvantage of the classical project life cycle is that a working model 
of the software system is not available until late in the project time span. This may cause two 
things: (1) A major bug undetected until the working program is reviewed can be disastrous 
[Ref. 11]. (2) The customer will not a have an idea of what the system will look like until it is 
complete. 

2. Prototyping Life Cycle 

Large real-time systems and systems which have hard real-time constraints are not 
well supported by traditional software development methods because the designer of this type 
of system would not know if the system can be built with the timing and control constraints 
required until much time and effort has been spent on the implementation. A hard real-time 
constraint is a bound on the response time of a process which must be satisfied under all 
operating conditions. 

To solve the problems raised in requirements analysis for large, parallel, distributed, 
real-time, or knowledge-based systems, current research suggests a revised software 
development life cycle based on rapid prototyping [Ref. 11, Ref. 13]. As a software 
methodology, rapid prototyping provides the user with increasingly refined systems to test and 
the designer with ever better user feedback between each refinement. The result is more user 



6 



involvement and ownership throughout the development/specification process, and 
consequently better engineered software [Ref. 14]. 

The prototyping method shown in Figure 2.2 has recently become popular. “It is a 
method for extracting, presenting, and refining a user’s needs by building a working model of 
the ultimate system - quickly and in context” [Ref. 15], This approach captures an initial set of 
needs and implements quickly those needs with the stated intent of iteratively expanding and 
refining them as the user’s and designer’s understanding of the system grows. The prototype 
is only to be used to model the system’s requirements; it is not to be used as an operational 
system [Ref. 16]. 



Initial 



y Goals 




Figure 2.2 Prototyping Life Cycle 

To manually construct the prototype still takes too much time and can introduce 
many errors. Also, it may not accirrately reflect the timing constraints placed on the system. 
What is needed is an automated way to rapidly prototype a hard real-time system which 
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reflects those constraints and requires minimal development time. Such a system should 
exploit reusable components and validate timing constraints. 

If we are to produce and maintain Ada software that is reliable, affordable, and 
adaptable, the characteristics of Ada may not be the only important matter to consider. In 
addition, the characteristics of Ada software development environments may well be critical 
[Ref. 171. 

3. Rapid Prototyping 

The demand for large, high-quality systems has increased to the point where a jump 
in software technology is needed. Rapid prototyping is one of the most promising solutions to 
this problem. Rapid prototyping is particularly effective for ensuring that the requirements 
accurately reflect the user’s real needs, increasing reliability and reducing costly requirement 
changes [Ref. 12], 




Figure 2.3 illustrates the iterative prototyping process, also known as “Spiral Model 
of Software Development”. In the prototyping cycle, the system designer and the user work 
together at the beginning to determine the critical parts of the proposed system. Then, the 
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designer prepares a prototype of the system based on these critical requirements by using a 
prototype description language [Ref. 9]. The resulting system is presented to the user for 
validation. During these demonstrations, the user evaluates if the prototype behaves as it is 
supposed to do. If errors are found at this point, the user and the designer work together again 
on the specified requirements and correct them. This process continues until the user 
deteniiines that the prototype successfully captures the critical aspects of the proposed system. 
This is the point where precision and accuracy are obtained for the proposed system. Then the 
designer uses the prototype as a basis for designing the production software. 

Some advantages and disadvantages of iterative development methodology are listed 

below: 

Advantages: 

• There is a constant customer involvement (revising requirements). 

• Software development time is greatly reduced. 

• Methodology maps to reality. 

• Allows use of common tools. 

• Disadvantages: 

• Configuration control complexities. 

• Managing customer enthusiasm. 

• Uncertainties in contracting the iterative development. 

The rapid, iterative construction of prototypes within a computer aided environment 
automates the prototyping method of software development and is called rapid prototyping 
[Ref. 18]. Rapid prototyping provides an efficient and precise means to detennine the 
requirements for the software system, and greatly improves the likelihood that the software 
system developed from the requirements will be complete, correct and satisfactory to the user. 
The potential benefits of prototyping depend critically on the ability to modify the behavior of 
the prototype with less effort than required to modi5^ the production software. Computer aided 
and object-based rapid prototyping provides a solution to this problem. 
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B. THE COMPUTER AIDED PROTOTYPING SYSTEM (CAPS) 



One of the major differences between a real-time system and a conventional system is 
required precision and accuracy of the application software. The response time of each 
individual operation may be a significant aspect of the associated requirements, especially for 
operations whose purpose is to maintain the state of some external system within a specified 
region. These response times, or deadlines, must be met or the system will fail to function, 
possibly with catastrophic consequences. These requirements are difficult for the user to 
provide and for the analysts to determine. 

An integrated set of computer aided software tools, the Computer Aided Prototyping 
System, has been designed to support prototyping of complex real-time systems, such as 
control systems with hard-real-time constraints. The Computer Aided Prototyping System 
[Ref. 1] supports rapidly prototyping of such complex systems by using a partially graphical 
specification language. The designer of a software system uses a graphic editor to create a 
graphic representation of the proposed system. This graphic representation is used to generate 
part of an executable description of the proposed system, represented in the specification 
language. This description is then used to search for the reusable components in the software 
base to find the components matching the specification of the prototype [Ref. 19]. A translator 
is used to translate the prototype into a programming language, currently Ada. The protot 3 q)e 
is then compiled and executed. The end user of the proposed system will evaluate the 
prototype’s behavior against the expected behavior. If the comparison results are not 
satisfactory, the designer will modify the prototype and the user will evaluate the protot 3 q>e 
again. This process will continue until the user agrees that the prototype meets the 
requirements, 

CAPS is based on the Prototyping System Description Language (PSDL). “It was 
designed to serve as an executable prototyping language at the specification or design level 
[Ref. 12].” An overview of PSDL will be presented in the following section. The main 
components of CAPS are user interface^ software database system, and execution support system 
(Figure 2.4). Figure 2.5 shows CAPS as SiW Advanced Rapid Prototyping Environment, and the 
interaction of the tools within the environment. 
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CAPS 



b 

Software Database I 


b 

Execution Support! 


System 1 


System 1 



User Interface 



Figure 2.4 Main Components of CAPS 



User Interface 




Figure 2.5 CAPS Advanced Rapid Prototyping Enviromnent: ARPE 
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C. THE PROTOTYPING SYSTEM DESIGN LANGUAGE (PSDL) 



PSDL is a partially graphical specification language developed for designing real-time 
systems, and specifically for CAPS. It is designed as a prototyping language to provide the 
designer with a simple way to specify the software systems [Ref. 2]. PSDL places strong 
emphasis on modularity, simplicity, reuse, adaptability, abstraction, and requirements tracing 
[Ref. 18]. 

A PSDL prototype consists of hierarchically structured set of definitions for OPERATORS 
and TYPES*, containing zero or more of each. Each definition has two parts: 

♦ Specification part: Defines the external interfaces of the operator or the type 
through a series of interface declarations, provides timing constraints, and 
describes functionality by using informal descriptions and axioms. 

• Implementation part: Says what the implementation of the component is going 
to be, either in Ada or PSDL. Ada implementations point to Ada modules which 
provide the functionality required by the component’s specification. PSDL 
implementations are data flow diagrams augmented with a set of data stream 
definitions and a set of control constraints. 



A PSDL component can be either a^omz^ or composite. An Atomic component represents 
a single module and cannot be decomposed into subcomponents. Composite components 
represent networks of components. The Implementation part of the component tells if the 
component is atomic or composite. 

L PSDL Computational Model 

PSDL is based on a computational model containing OPERATORS that communicate 
via DATA STREAMS. Modularity is supported through the use of independent operators which 
can only gain access to other operators when they are connected via data streams. 

PSDL is formally represented by the following computational model as an 
augmented graph by Luqi et al. [Ref. 2]: 

G = (V£,r(v),c(v)) 



We will name them as the “psdl component” in the following chapters. 



12 



where 



V is a set o/'vertices 
E IS a set o/' edges 

T(v) is the set of timing constraints for each vertex v 
C(v) is the set of control constraints for each vertex v 

Each vertex represents an operator and each edge represents a data stream. The PSDL 
grammar is given in Appendix A. 

a. Operators 

Every operator is a state machine, modeled internally by a set of state variables. 
Operators that do not have state variables behave like functions, i.e., they give the same 
response each time they are triggered. A state machine produces output whose value depends 
upon the input values and on internal state values representing some part of the history of the 
computation, whereas a function produces output whose value depends on only the current 
input values [Ref. 17]. Operators can be triggered either by the arrival of input data values or 
by periodic timingconstraints, which specify the time intervals for which an operator must fire. 

Operators are also either periodic or sporadic. Periodic operator's fire at regular 
intervals of time while sporadic operators fire when there is new data on a set of input data 
streams. 



6. Data Streams 

Data streams represent sequential data flow mechanisms which move data 
between operators. There are two kinds of data streams: data-flow and sampled. Data-flow 
streams are similar to FIFO queues with a length of one. Any value placed into the queue must 
be read by another operator before any other data value may be placed into the queue. Values 
read from the queue are removed from the queue. Sampled data streams may be considered as 
a single cell which may be written to or read from at any time and as often as desired. A value 
is on the stream until it is replaced by another value. Some values may never be read, because 
they are replaced before the stream is sampled. Data streams have data-flow queues if and only 
if they appear in a TRIGGERED BY ALL control constraint. 
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c. Timing Constraints 

Timing constraints in PSDL impose an order on operator firing that is based on 
timing constraints: 

• Maximum Execution Time (met) 

• Deadline (fiv) or Maximum Response Time (mrt) 

• Minimum Calling Period (mcp) 

Every time-critical sporadic operator has an mrt and mcp in addition to an met. 

The met is an upper bound on the length of time that an operator may use to 
complete its function. 

The mrt defines an upper bound on the time that may elapse between the point 
in time at which an operator is fired to read from its input streams and the time when its write 
event occurs. Tlie mrt applies only sporadic operators. 

The mcp applies only to sporadic operators and represents a lower bound on the 
time between the arrival of one set of inputs and the arrival of another set of inputs (i.e. two 
successive activations of the read transitions of an operator (Figure 2.6). The mcp can be 
considered as the window of opportunity for the operator to use, and the mrt as the used portion 
of it. 
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Figure 2.6 The mcp and mrt of an operator 



Periodic operators are triggered by temporal events and must occur at regular 
time intervals. For each operator f, these time intervals are determined by the specified period 
(OPERATOR /'PERIOD and deadline (OPERATOR /'FINISH WITHIN f). 

The period is the time interval between two successive activation times for the 
read transition of a periodic operator. The period applies only periodic operators. 
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The deadline (fw) defines an upper bound on the occurrence time of the write 
transition of a periodic operator relative to the activation of its read transition. By default, the 
deadline is equal to the met, and a static feasibility constraint requires that fw'^met (Figure 
2.7). 
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Figure 2.7 The period and deadline of an Operator 



The difference between the activation time of a read transition and the deadline 
for the corresponding write transition is called the scheduling intervaL The scheduling 
intervals of a periodic operator can be viewed as sliding windows, whose position on time axis 
relative to each other is fixed by the period, and whose absolute position on the time axis is 
fixed by the occurrence time /q of the first read transition. This time may vary within the 
interval 0 to the period of the operator (Figure 2.8). 
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Figure 2.8 Scheduling Interval of an Operator 



d. Control Constraints 

The control constraints are the mechanisms which refine and adapt the behavior 
of PSDL operators. They specify how an operator may be fired, how exceptions may be raised, 
and how or when data may be placed onto an operator’s output data streams by using predicate 
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expressions. They also control timers, which are “software stopwatches” used to control 
durations of states. 

Triggering conditions and guarded outputs are expressed by predicates. If an 
input stream is guarded by a triggering condition, input data which do not satisfy the condition 
are read from the stream but do not fire the operator. Similarly, guarded output streams of an 
operator prevent the specified output data from being written into the guarded streams if the 
output guard conditions are not satisfied. 

Synchronization between different operators in PSDL is achieved by precedence 
constraints. These constraints are introduced by data streams as follows: 

Data-flow streams ensure that values are not read until they are written, and 
that a value is not overwritten before it has been read. This property ensures that transactions 
are not lost or repeated, and can be used to correlate data from different sources, such as 
preprocessor operators operating in parallel. Sampled streams cannot guarantee that values 
will never be overwritten before they are read. The purpose of a sampled stream is to provide 
the most recent available version of data. 

The precedence constraints associated with sporadic operators are implicit. 
Periodic operators are triggered by temporal events rather than by arrival of data values, and 
in certain conditions the precedence constraints can affect these timing constraints. 

2. PSDL Prototype Example 

The data-flow diagram in Figure 2.9 shows a fragment of a PSDL design graph with 
operators A and B, and data streams a, 6, c, d. The graph also indicates maximum execution 
times, 10 ms for operator A, and 20 ms for operator B, These timing constraints are the 
maximum execution times for each operator to process data they receive via the input data 
streams. 




Figure 2.9 PSDL data-flow diagram with control constraints 
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Figure 2.10 [Ref. 20] shows a simple control system illustrating some typical features 
of PSDL. The example has a minimal specification part with an informal description. The 
implementation part contains a graph, making the operator ControlSystem a ‘"composite” 
operator. The filter operator must be fired periodically, every 100 milliseconds. 



OPERATOR ControlSystem 

SPECIFICATION 

INPUT InputSwitch: BOOLEAN, SensorData: REAL 

OUTPUT ControlSignal: REAL 
STATES StateVariable: REAL INITIALLY 0.0 

DESCRIPTION {top level of a simple embedded system) 

END 

IMPLEMENTATION 

GRAPH 





OPERATOR filter PERIOD 100 ms 

OPERATOR controller TRIGGERED BY ALL InputSwitch 

MAXIMUM RESPONSE TIME 200 ms 

MINIMUM CALLING PERIOD 200 ms 

END 



END 



Figure 2.10 Example of an Augmented Data-flow diagram in PSDL 



The controller operator is a sporadic operator, it must be fired whenever a new value 
for the InputSwitch arrives, and must complete execution in 200 milliseconds. The stream 
InputSwitch is a data stream, while SensorData and StateVariable are sampled streams. The 
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triggering conditions state the requirements for the controller and actuator to respond exactly 
once to every new value in the streams InputSwitch. 
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III. DESIGN OF THE PSDL EXPANDER 



This chapter presents the design of the expander. To establish a convenient 
representation of PSDL specifications, we define a PSDL Abstract Data Type (ADT) that 
provides an Ada representation of a PSDL program. The PSDL ADT is built by using other 
common mathematical data types, like graphs, sets, maps, and sequences. The Ada 
specifications and implementations of those abstract data types are given in Appendices J, K, 
L, M, and N for reference. 

A INTRODUCTION 

The main program of the expander consists of following operations: 

(i) Get PSDL program (get) 

(ii) Transform the multi-level PSDL file (expand) 

(iii) Output expanded PSDL program tput) 

In the first step the input PSDL program is read and parsed by a LALR(l) parser, con- 
structed by using the tools ayacc and a flex, which are Ada versions of the parser generator tools 
yacc and lex that are provided by UNDC. A brief overview of the tools ayacc and aflex is given 
in the next section. During the parsing process PSDL operator names are mapped to operator 
descriptions and PSDL ADT representation of the program is created. 

The second step is the expanding step; in this step the abstract representation of PSDL 
program in Ada is used to translate multi-level PSDL program into a two-level one. Dining this 
translation process the transformation of the PSDL, graph is transformed, and the timing con- 
straints are propagated into the new representation of the PSDL program. Tlie diagram in Fig- 
ure 3.1 shows a high level diagram of this process. We explain the design of the graph trans- 
formation and timing constraint propagation in the following sections. The implementation of 
the graph transformation is given in Chapter IV. The implementation of the propagation of the 
timing constraints is left for future research. 
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In the third step, the Ada representation of expanded PSDL program is written into a text 
file to be used by other tools in CAPS. In the output file some normalizing conventions are used. 
For instance all timing values are converted to and output in units of millisec, and lists of type 
declarations are output in the format varl: typejnameh var2: typejnamely var3: typejmmel. 
The steps in the expanding process is shown in Figure 3.2. 





Figure 3.2 The Steps in the Expanding Process 
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B. USE OF PSDL ABSTRACT DATA TYPE 
1. Abstract Data Types in General 



All abstract data type, by definition, denotes a class of objects whose behavior is 

defined by a set of values, including a set of operations, constructors, selectors, and iterators. 

Luqi and Berzins [Ref. 17] describes the abstract data type concept as: 

Abstract data types can be defined by the developer or predefined by the 
programming language. Each abstract data type is itself a system whose interaction 
interfaces consist of the associated primitive operations. Each interaction with a 
primitive operation involves the flow of one or more data objects across the boundary of 
the abstract data type, at least one of which must be an instance of that type. 

An abstract data type is a class of data structures described by an external view: 

available services and properties of these services^ [Ref 21]. In the case of the PSDL ADT, these 
services are constructors, iterators, queries, exception definitions^ and other type definitions,. 
Using the abstract data type descriptions, we, as the users, do not care about how the 
implementation has been done, i.e. wliich data structures have been used; what is important 
for us is what operations it has - what it can offer to other software elements. This decouples 
the detailed implementation and storage representation information from program segments 
that use the abstract data type but have no need to know that information. 

2 . Motivation and Benefits of PSDL ADT 

The main motivations for the PSDL ADT is to provide an Ada representation of the 
PSDL specifications to support building the expander and other tools within CAPS. The PSDL 

ADT includes operations for constructing PSDL components^, queries for basic attributes of 
PSDL components, and outputting the PSDL ADT as a PSDL program in a text file format (put 
operation), without worr>dng about how these operations are implemented. 



* These services are operations, other type definitions, and exceptions, constants, etc. 
^ Psdl components are operators or PSDL types. 
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The benefits of the PSDL ADT follow: 



• It provides a common input/output facility for PSDL programs for the tools within 
CAPS. 

• It makes the interface between the various CAPS tools cleaner by hiding 
unnecessary implementation details. 

• The whole PSDL program is treated as a single data structure, holding the all 
attributes of PSDL specification. Since the PSDL ADT provides all necessary 
operations, attributes can be queried easily. 

• It improves the efficiency and speed of the whole prototyping process in the CAPS, 
since there is no need for an external file I/O for reading the PSDL source text files. 

• It provides efficient storage usage, since all the memory management issues are 
managed by the PSDL ADT itself. 

• It provides improved exception handling and semantic checking features. 

3. What is the Interface to the PSDL Abstract Data Type? 

As we mentioned in the previous chapter, a PSDL program is a set of definitions of 
PSDL components, i.e. operators, and data types. Each component has a unique name and 
description which is composed of specification and implementation parts. A PSDL component 
definition can be represented as a function from PSDL id's to PSDL definitions. Thus, a PSDL 
program can mathematically be represented as a map on PSDL component names as the 
domain and PSDL component definitions as the range. As part of the PSDL ADT, we define a 
type PSDL_PROGRAM, which is a map from psdl component names to psdl component 
definitions, that is a dynamic collection of bindings from the PSDL component names - 
domainy to PSDL definitions - range. We can view the value of PSDL_PROGRAM as an 
unordered collection of ordered pairs consisting of componentjd’s and component_descrlption’s. 

psdLprogram {from :: componentjd, to :: component_description} 

A graphical representation of a PSDL_PROGRAM as a map is illustrated in Figure 3.3. 
PSDL_PROGRAM has all the characteristics that a map ADT carries (see [Ref. 17, App. D]), and 
the operations defined for maps are also valid for PSDL_PROGRAM. 
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Componentjd Component_Description 




Figure 3.3 The Abstract Representation of a PSDL_PROGRAM as a map 



In the PSDL ADT the basic data type is PsdLComponent. Instances of this type hold 
all the information that a PSDL component (operator or data type) carries. The component 
hierarchy in PSDL is represented by a type hierarchy which is illustrated in Figure 3.4. The 
type attributes are shown in Figures 3.5 and 3.6. 



PsdLComponent 




Figure 3.4 PSDL ADT Type Hierarchy 
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type PsdLComponent 
SUPERTYPE None 
ATTRIBUTES 
Name: string 

Generic: map {string, Type_Name} 
Keywords: set{string} 

Description: string 
Axioms: string 



type Data_Type 

SUPERTYPE PsdLComponent 

ATTRIBUTES 

Model: map {string, Type_Name) 
Operations: map {Id, Operator} 



type Operator 

SUPERTYPE PsdLComponent 

ATTRIBUTES 

Input: map {string, Type^Name) 
Output: map {string, Type_Name) 
States: map {string, Type_Name} 
Initialization: map {string, expression} 
Exceptions: set{string} 

Met: millisec 



I 

I 

i 



I 



I 



is 



I 



I 






I 









Figure 3.5 Attributes of type PsdLComponent and type Data_Type 
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type Atomic_Operator 

SUPERTYPE Operator 
ATTRIBUTES 

Ada_Name: string 

type Composite_Operator 
SUPERTYPE Operator 
Graph: Psdl_Graph 
Streams: map {string, Type_Name} 

Timers: set{string} 

Triggers: map {string, Trigger Type} 
Exec_Guard: map {string, expression} 
Output_Guard: map {string, expression) 
Exception_Triggers: map {string, expression) 
Timer_Op: map {string, set{timer}} 

Period: map {string, millisec) 

Finish_Within: map {string, millisec) 
Min_Calling_Period: map {string, millisec) 
Max_Response_Time: map {string, millisec) 
Description: string 

type Atomic_Type 

SUPERTYPE Data_Type 
ATTRIBUTES 

Ada_Name: string 

type Composite_Type 

SUPERTYPE Data_Type 
ATTRIBUTES 

Data_Structure: Type_Name 






Figure 3.6 Attributes of Atomic_Operator, Composite_Operator, Atomic_Type and 

Composite_Operator 



Some of the types used in the definitions of Psdl_Component and its subtypes are user- 
defined, and tliey are explained in Chapter IV. The fonnal and infonnal definitions, and an 
implementation of maps and sets can be found in [Ref. 17]. Some other implementations can 
also be found in [Ref. 22]. The map and set implementations we used are based on the ones 
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that are defined in [Ref. 17] with some improvements. The implementations are given in 
Appendices L and M. 

Four basic operations needed for the PSDL ADT are the constructor operations for 
the type hierarchy described above. Those are: 

• Make_Composite_Operator 

• Make_Atomic_Operator 

• Make_Composite_Type 

• Make_Atomic_Type 

The other operations provided with PSDL ADT are operations used for adding 
attributes to PsdLComponent and query operations for attributes. A set of exceptions are also 
defined to signal failures of run-time checks for violation of subtype constraints, and to signal 
some semantic errors. Tliese operations take place in the type hierarchy, and we describe them 
in Chapter IV. 



C. USING AYACC AND AFLEX IN PSDL ADT 

We used a LALR(l) parser to parse the PSDL specification to construct the PSDL ADT. 
The parser is generated by using tools ayacc- a parser generator, and aflex - a lexical analyzer, 

Ada implementations of popular UNK^ tools yacc [Ref. 23] and lex [Ref. 24]. Ayacc and aflex 
have been implemented as part of the Arcadia Environment Research at Department of Infor- 
mation and Computer Science, University of California, Irvine. Both of the tools generate Ada 
code, which in our case, provides compatibility with the other tools in CAPS that are imple- 
mented in Ada. 



1. Ayacc 

Ayacc generates a parser from an input of BNF style specification grammar, 
accompanied by a set of Ada program fragments (actions) to be executed as each grammar rule 



* UNIX is a trade mark of AT&T, Bell Lab Laboratories. 
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is recognized. Ayacc uses a push-down automaton to recognize any LALRd ) grammar [Ref. 3], 
and generates a set of Ada program units that act as a parser for the input grammar. 

2. Aflex 

Aflex is a lexical analyzer generating tool written in Ada designed for lexical 
processing of character input streams. It is a successor to the Alex [Ref. 25] tool from UCI, 
which was inspired by the popular UNIX tool lex and GNU flex. Aflex accepts high level rules 
written in regular expressions for character string matching, and generates Ada source code 
for a lexical analyzer, by using a finite state machine to recognize input tokens [Ref. 4]. Aflex 
can be used alone for simple lexical analysis, or with ayacc to generate a parser front-end, as 
we have done in constructing the PSDL expander. 

3. PSDL Parser 

The PSDL parser’s primaiy responsibility is transforming the PSDL prototj^ie 
source program into the PSDL abstract data type (described in section III.B). The parser has 
been constructed with ayacc and aflex. We adapted the PSDL grammar to make it suitable for 
ayacc input. The parser reads the PSDL program and constructs the PSDL ADT by using some 
auxiliary Ada packages. The top level diagram of the parser and PSDL ADT generation 
process are illustrated in Figure 3.7 and Figure 3.8 respectively. The implementation strategy 
of the parser is discussed in detail in Chapter TV. 

The parser reads the PSDL program, locates any syntax errors, and if no errors are 
present, constructs the PSDL ADT by using the auxiliar>^ Ada packages. In the current 
implementation of the parser error recovery is not implemented and the parser will abort the 
execution at the first error encountered. This is a reasonable design because the PSDL code 
will be generated by the Syntax-Directed Editor of CAPS, and tliis should be syntactically 
correct. During the PSDL ADT generation process, a limited set of semantic eirors in the PSDL 
specification are also detected, and suitable exceptions are raised. 
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Figure 3.7 Parser Generation Process 




Figure 3.8 PSDL ADT Generation Process 



28 



As can be seen from Figure 3.1 the parser acts as a get operation in the whole 
process. Tlie implementation strategy of the parser and the data structures used in the parser 
are discussed in detail in Chapter IV. 

4. Known Deficiencies and Limitations of PSDL ADT 

In the current version of the PSDL ADT, BY REQUIREMENTS clauses are ignored. The 
substnicture of expressions in PSDL is not represented. Extensive semantic checking of input 
PSDL specification is not done in parser or in the PSDL ADT, but some explicit run-time checks 
for violation of subtype constraints are done in the PSDL ADT. 

The parser does not have an error recovery scheme, and it aborts its execution at the 
first syntax error in the input PSDL specification file, by giving the line number and the most 
recent token recognized. 

D. DESIGN OF THE PSDL EXPANSION PROCESS 

This section describes a single processor design of the expansion process. The expansion 
of the Ada representation of the PSDL specification is done in two parts: 

• Transformation of the graphs 

• Propagation of timing constraints. 

The next two sections describe these two models using expansion templates that illus- 
trate typical cases of the transformations. 

1. Transformation of the Graph 

An example of PSDL specification is shown in Figure 3.9. This represents a top-level 
operator (level 1) or root operator that decomposes into sub modules or operators. A root 
operator in PSDL does not have any input or output streams, but may have state variables. 
The implementation part represents the first decomposition or second level. Since the 
implementation of tliis operator is given as a graph, the operator is a composite. We are going 
to take this PSDL program as an example for our design. In tliis example. Operator A 
represents a simulation of an external system, and operator B represents a software system. 
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This corresponds to the context diagram of the entire system, in which represents a state 
variable; and v represents a data stream. 



OPERATOR Example 
SPECIFICATION 

STATES u: REAL INITIALLY 0.0 

DESCRIPTION { Top-level of a simple prototype, some of the 
structures are not shown) 

END 

IMPLEMENTATION 

GRAPH 







CONTROL CONSTRAINTS 
OPERATOR A 

PERIOD 100 ms 
OPERATOR B 

TRIGGERED BY ALL u 
MAXIMUM RESPONSE TIME 200 ms 
MINIMUM CALLING PERIOD 200 ms 

END 

END 






I 






Figure 3.9 Top Level of Example Prototype 



Let us assume that the prototype Example is a four-level** prototype. The expanded 
data-flow graph of prototype Example is shown in Figure 3.10. Suppose that operator A and 
operator B have the PSDL specifications as shown in Figures 3.11. and 3.12. 




The number of levels in deepest decomposition of the data-flow graph. 
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OPERATOR A 

SPECIFICATION 

INPUT v: BOOLEAN 
OUTPUT u: REAL 

DESCRIPTION {this operator represents a simulation of an external 
system} 

END 

IMPLEMENTATION 

GRAPH 




CONTROL CONSTRAINTS 
OPERATOR A1 
OPERATOR A2 

TRIGGERED BY ALL s1 
MAXIMUM RESPONSE TIME 200 ms 
MINIMUM CALLING PERIOD 200 ms 
OPERATOR A3 
PERIOD 50 sec 
OPERATOR A4 

FINISH WITHIN 200 ms 

END 

END 









Figure 3.11 PSDL Code for Operator A 
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OPERATOR B 

SPECIFICATION 
INPUT u: REAL 
OUTPUT v: BOOLEAN, 
DESCRIPTION {<text>) 

END 

IMPLEMENTATION 

GRAPH 




CONTROL CONSTRAINTS 
OPERATOR B1 
OPERATOR B2 

TRIGGERED BY ALL11 
MINIMUM CALLING PERIOD 200 ms 
OPERATOR B3 
PERIOD 50 sec 

END 

END 



I 

I 

% 

I 

Xv 






Figure 3.12 PSDL Code for Operator B 



The operators B1 and B2 are assumed to be atomic, and their PSDL code is not shown 
here. The expanded diagrams (level 3) of operators A and B are shown below side by side: 
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V 




Figure 3.13 (a) Expanded Operator A (level 3), (b) Expanded Operator A (level 3) 



Now, we assume that operator B3 also has a decomposition and has the PSDL code 
in Fig 3.14. 



OPERATOR B 

SPECIFICATION 

INPUT t2: CHARACTER 
OUTPUT t3: REAL, 

END 

IMPLEMENTATION 

GRAPH 




OPERATOR B1 
OPERATOR B2 
PERIOD 500 ms 
OPERATOR B3 
PERIOD 50 sec 

END 
END 






I 



I 

i 




Figure 3.14 PSDL Code for Operator B3 
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This implies that operator B3 decomposes into the data-flow graph shown in Figure 
3.15, and we assume that there is no further decomposition, so that the operators B31, B32 and 
B33 represent atomic operators. 




Figure 3.15 Expanded Operator B3 (level 4) 

The equivalent two-level prototype consists of the root level operator with a 
decomposition that is given by the expanded graph shown in Figure 3.16. The shading 
illustrates the derivation of the expanded graph, but it is not part of the expanded graph that 
is derived from the composite operators’ graphs. In the final expanded graph all of the 
operators are atomic and their implementations are in Ada. 
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2. Propagation of Timing Constraints 

PSDL timing constraints impose some consistency requirements between the various 
levels of a hierarchical PSDL design. This section provides the design of a method to propagate 
these timing constraints into the two-level representation of PSDL program. 

We describe each type of timing constraint associated with the liierarchy in the 
following subsections. Some very basic consistency checking between the timing constraints of 
various levels is also done, and error messages are produced as appropriate. 

a. Maximum Execution Time and Deadline (Finish Within) 

The maximum execution time (met) is an upper bound on the length of time 
between the instant when an operator is executed and the instant when the execution is 
terminated. The deadline (fw) defines an upper bound on the occurrence time of the write 
transition of a periodic operator relative to the activation of its read transition. The maximum 
execution time constrains a single operator, and for a single processor execution model, the 
maximum execution of a composite operator is the sum of the maximum execution times of the 
child operators. This sum must be no larger than the deadline of the parent operator. Also the 
maximum execution time of the parent must be no less than the sinn of the mets of the children. 

n 

i = 1 
n 

parent where i ^ 0, and ij.. denotes the children 

i = I operators 

For a multiprocessor execution model the above sums are calculated for the 
operators on each path of the graph. 

b. Period 

The period is the time interval between two successive activation times for the 
read transition of a periodic operator. The components or the cliildren operators of a composite 
operator must be periodic, and assigned the same period as the parent operator as a default 
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value if the designer did not explicitly provide periods for the children operators. This 
inheritance property is realized by the expanding process. The period of a composite operator 
is propagated to each cliild operator with the same value. The consistency check between the 
period and the met of the operator can be done at this point, and for a single processor 
operation, the expander should also check that met ^period for each operator, to allow the 
operator to complete its execution within the specified period. 

c. Minimum Calling Period 

The minimum calling period (mcp) represents a lower bound on the time 
between the arrival of one set of inputs and the arrival of another set of inputs. The children 
operators inherit the mcp from the parent composite operator if they do not have an mcp 
explicitly specified by the designer. So the mcp of the parent operator is propagated to the each 
child operator with the same value. But a static consistency check between the mcp and met 
must be done, and in a single processor model the relation met ^ mcp must be satisfied by each 
child operator. If this condition is not satisfied an exception should be raised, and an error 
message produced. 



d. Maximum Response Time 

The maximum response time defines an upper bound on the time that may 
elapse between the point in time at which an operator is enabled to read from its input streams 
and the time when its write event occurs. The sum of mrts of operators on each path of a sub- 
graph must be no larger than the mrt of the parent composite operator, and the met of each 
child operator must be no larger than the corresponding mrU otherwise an exception is raised. 



n 

^ mrt^^ parent where k'^0, and denotes the children 

, _ 1 operators on each path of the composite operate 



met^< mrt^ 



where /"is any operator. 
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3. Other Hierarchical Constraints 



A composite operator inherits the exceptions from the children operators, so during 
expansion process there is nothing to be done for propagating these properties. If there is an 
exception for a composite operator, that inherits from an atomic operator in the sub-graph. 



Input and output guards are inherited by conjunction, as illustrated in Figure 3.17. 




Control Constraints before the expansion: 

OP A TRIGGERED IF P(x) 

OUTPUT y IF Q(y) 

OP A1 TRIGGERED IF Pl(x) 
OP A2 OUTPUT IF Q2(u, y) 

OP A3 OUTPUT IF Q3(v, y) 



Control Constraints before the expansion: 

OP A1 TRIGGERED IF P(x) AND P1 (x) 
OP A2 OUTPUT IF Q(y) AND Q2(u, y) 
OP A3 OUTPUT IF Q(y) AND Q3(v, y) 



Figure 3.17 The Inheritance of Input and Output Guards 
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Input guards are propagated to all the sub-operators that read the input streams 
mentioned in the guard. Output guards are propagated to all the sub-operators that write the 
output streams mentioned in the guard. 
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IV. IMPLEMENTATION OF THE PSDL EXPANDER 



This chapter describes the implementation of the PSDL expander and its main 
components, the PSDL ADT, parser, expander and the output operation. Tlie skeleton of the 
main program for the expander is shown in Figure 4.1 . Each line corresponds to one of the main 
components of the PSDL expander. 

i 

f 
i 

W- 



I 

The next four sections describe the purpose, implementation and functionality of each 
component. We do not describe the implementation of each single routine, rather we emphasize 
the implementation techniques for some “key” routines. The routines or modules that are not 
described in this chapter should be easy to follow with comments associated with them in the 
source files given in the Appendices. 



with PsdLComponent_Pkg, Psdl_lo; 
use Psdl_Component_Pkg; 

procedure Expander is 

The__Psdl_Component: Psdl_Progrann:= Empty_Psdl_Program; 

begin 

Psdl_lo.Get(The_Psdl_Corriponent); 

Expand (The_Psdl_Component); 
PsdLlo.Put(The_PsdLComponent); 
end Expander; 



Figure 4.1 Tlie Skeleton Main Program 



A. PSDL ADT 

Purpose: 

The PSDL ADT provides an abstract representation of a PSDL program in Ada. With the 
operations provided by the PSDL ADT, components can be constructed and component in- 
stance attributes can be queried, changed or added. 
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Implementation: 



The specification for the PSDL ADT is given in Appendix F as PsdLComponent_Pkg, The 
initial version of specifications was written by Valdis Berzins. We made the modifications and 
enhancements to those specifications during the design and implementation of the PSDL 
parser. There are still some enhancements that can be done to the specifications, but they have 
not been done due to lack of time and are left for future work. These enhancements are de- 
scribed in Chapter VI. 

The PSDL ADT’s main type is PsdLComponent, and defined as a private record with dis- 
criminants to represent the PSDL component hierarchy in Ada. Information hiding and some 
encapsulation are provided by making PsdLComponent a private type. This limits access to the 
type to be just the operations provided by the PSDL ADT. For instance, the construction of a 
new instance of PsdLComponent, modifications or queries of instance attributes can only be 
done via the operations provided by the PSDL ADT. The main types defined in the PSDL ADT 
represent the components in the PSDL hierarchy (see Chapter III, Figure 3.4). The Ada decla- 
rations are shown in Figure 4.2 and the definition of PsdLComponent is shown in Figure 4.3. 
The user-defined types used in the definition of PsdLComponent are defined in the package Ps- 
dl_Concrete_Type_Pkg (Appendix I). 



type PsdLComponent (Category: Component_Type:= Psdl_Operator; 

(Granularity: lmplementation_Type:= Composite) is private; 

subtype Operator is PsdLComponent; 
subtype Data_Type is PsdLComponent; 

subtype Atomic_Operator is Operator (Category => Psdl_Operator, 

Granularity => Atomic); 

subtype Composite_Operator is Operator (Category => Psdl_Operator, 

Granularity => Composite); 

subtype Atomic_Type is Data_Type (Category => Psdl_Operator, 

Granularity => Atomic); 

subtype Com posit e_Type is Data_Type (Category => Psdl_Operator, 

Granularity => Composite); 






Figure 4.2 The Main Types in PSDL ADT 
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Instances of each type shown in Figure 4.2 hold all the information that a corresponding 
PSDL component carries. Since a PSDL program is a collection of those components, the whole 
PSDL program is represented by a mapping from component names to component descriptions 
(the record Psdl_Component). 



type Psdl_Component(Category: Component_Type:= Psdl_Operator; 

(Granularity: lmplementation_Type:= Composite) is 

record 

Name: PsdIJd; 

Gen_Par: Type_Dectaration; 

Keyw: ld_Set; 
lnf_Desc, Ax: Text; 
case Category is 

when PsdLOperator => 

Input, Output, State: Type_Declaration; 

Init: lnit_Map; 

Excep: ld_Set; 

Smet: Millisec; 
case Granularity is 
when Atomic => 

0_Ada_Name: Adajd; 
when Composite => 

G: PsdLGraph; 

Str: Type_Declaration; 

Tim: ld_Set; 

Trig: Trigger_Map; 

Eg: Exec_Guard_Map; 

Og: Out_Guard_Map; 

Et: Excep_Trigger_Map; 

Tlm_Op: Timer_Op_Map; 

Per, Fw, Mcp, Mrt: Timing_Map; 
lmpl_Desc: Text; 
end case; 
when Psdl_Type => 

Mdl: Type^Declaration; 

Ops: Operation_Map; 
case Granularity is 
when Atomic => 

T_Ada_Name: Adajd; 
when Composite => 

Data_Str: Type_Name; 
end case; 
end case; 
end record; 



I 



I 



I 






i 
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Figure 4.3 The Definition of Psdl_Component 
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We declare a pointer (an access type in Ada) to PsdLComponent to reference a psdl compo- 
nent, and the mapping is from component name to this pointer. The pointer type is necessary 
to avoid circular dependencies. The mapping is implemented as an instantiation of a generic 
map package by providing the necessary generic parameters. The Ada declaration of this in- 
stantiation is shown in Figure 4.4. 



I 



The PSDL ADT uses several other auxiliaiy Ada packages. These are: 

• Psdl_Concrete_Type_Pkg: This package provides the data structures and defined 
types used by the PSDL ADT (Appendices F and G). 

• Psdl_Graph_Pkg: It provides a an abstract data type representation of the data-flow 
graph portion of the PSDL program, and has a set of operations for constructing a 
data-flow graph and attribute queries. Specification and implementation are given 
in Appendices J and K. 

• Generlc_Map_Package: This is a generic mathematical map package, and carries all 
the typical map operations. This implementation of map is based on the formal 
definition by Luqi and Berzins [Ref. 17], and was enhanced by adding more 
features and better memory management. The package uses set as the main data 
structure, which is also based on the one in [Ref. 17]. This package also utilizes 
sets and maps in the implementation. 

The operations, and exception definitions provided by the PSDL ADT are not listed here, 
they are self explanatory in the source code listing, which is given in Appendix G. 

One of the additions that we have made to the PSDL ADT is the output operation put used 
in the main program, that outputs the expanded PSDL program by extracting from the PSDL 
ADT, into a text file for further use by other tools within CAPS. Although this operation is em- 
bedded into the PSDL ADT, it is worthwhile to devote a whole section to describe it due to the 



type Component_Ptr is access PsdLComponent; 

package Psdl_Program_Pkg is new Generic_Map_Pkg (Key => Psdljd, 

Result => ComponenLPtr); 

type PsdLProgram is new Psdl_Program_Pkg.Map; 

- A psdl program is an environment that binds psdl component names 

- to psdl component definitions. 

- The operations on PsdLProgram are the same as the operations on map. 



Figure 4.4 Declaration of type PSDL_PROGRAM 
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complexity of its functionality. The implementation of the output operation put is described in 
Section D of this Chapter. 

B. PSDL PARSER 

PurpQ$ ?; 

To implement the^e^ operation for the PSDL expander, and to construct the abstract rep- 
resentation of the PSDL program in Ada by using the PSDL ADT. In other words, the PSDL 
parser and the PSDL ADT comprise ih^get operation for the PSDL expander. The parser reads 
in the PSDL source program from a text file, and builds an instance of type PSDL_PROGRAM 
representing the whole PSDL program as an Ada object. 

Implementation; 

We generated the parser by using the tools ayacc and aflexy a parser generator and a lex- 
ical analyzer. The detail of the tools and how they are used to generate a parser can be found 
in [Ref. 3 and Ref. 4]. The parser generated by ayacc is an LALR(l) parser.* For the character- 
istics of LALR(l) parsers and their constructions refer to [Ref. 5 and Ref. 6]. 

The PSDL parser or get operation has two basic parts, which are explained in the next 
two sections: 

• Lexical analyzer 

• Parser 



1. Lexical Analyzer 

The Lexical analyzer is written in aflex. Aflex generates a file containing a lexical 
analyzer function (YYlex) along with two auxiliary packages. Since our purpose was to 
generate a parser, we implemented the lexical analyzer as an Ada package (package Psd!_Lex 
in file psdl_lex.a, given in Appendix R), containing the lexical analyzer function YYlex 
which is called by the parser function YYParse. The file psdl_lex . 1 (Appendix B) is the input 
to aflex, and defines the lexical classes and the regular expressions used in the PSDL grammar. 

LookAhcad Left Recursive parser that can look ahead one token. 
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Each regular expression has an associated action^ written in Ada, which is executed when the 
regular expression is matched. Each call (by the parser procedure YYParse) to YYlex returns a 
single token. The type Token is an enumeration type defined in a package called Psdl_Tokens 
(Appendix X), that is generated by ayacc from the token declarations part of the ayacc 
specification file. 

The auxiliary packages include Psdl_Lex_Dfa and Psdl_Lex_lo packages. The package 
Psdl_Lex_Dfa contains functions and variables that are externally visible from the scaimer. 
One of the most frequently used ones in our implementation is YYTexty which returns a textual 
string representation of the matched input token in type string. We used this function exten- 
sively in the actions of the parser to get the string value of the tokens recognized. One of the 
problems that we encountered was, in the case when the input token is a literal (string, integer 
or real literal), or an identifier, YYText sometimes returns the string value of the lookahead 
token. To work around this problem (as it is suggested by John Self, the author of the tool), we 
declared one global variable for each type of token we mentioned above, and assigned the value 
returned by YYText as soon as the token is recognized, and we used those global variables, in 
the ayacc actions instead YYText when needed. This works except when two identifiers come 
after another. To compensate for this special case, we had to declare two global variables of 
type PsdLId in the user declarations part of the aflex specification: one representing the most 
recently scanned identifier, and the other the previously scanned identifier. This special case 
arises in the production for type_naine, A reference to the previous identifier is needed in the 
case where there are two consecutive type declarations after keyword "generic" in a psdl 
type specification part of the rules. The package Psdl_Lex_Dfa also contains another frequently 
used function YYLength which returns the length of the string representation of the matched 
token. 

The package Psdl_Lex_lo contains routines which allow yyZcr to scan the input source file. 
These are described in [Ref. 3]. 

We added two procedures in the package Psdl_Lex by putting them in the “user defined” 
section of the aflex specification file psdl_lex . 1 and the generated file psdl_lex . a. These 
are Linenum and Myecho. Linenum keeps track of the number of lines in the input file, using 
the global variable lines - type positive, and used for giving the location of the syntax errors. 
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Myecho writes the textual string representation of each matched token into a text file by ap- 
pending the line numbers at the beginning of each line. This file is named as <input- 
flle>. 1st, and is used to provide a listing file for the input PSDL source file. 

2. Parser 

The parser is written in ayacc, a parser generator tool. Ayacc constructs a parser 
which recognizes a language specified by an LR(1) grammar. The main parser procedure 
YYParse makes a call to lexical analyzer function YYLex to get an input token, and then 
matches the grammar rules and executes the actions associated with these grammar rules. 
Although it is simple we will not explain how the parser works (see [Ref. 4]), since it is not our 
concern, instead we will concentrate on the semantic actions for the rules in the input 
specification file. 

a. Ayacc Specification File: psdl . y 

This file is a collection of grammar rules and actions associated with them, along 
with the Ada subprograms we provided to be used in the semantic actions. A detailed 
description of the ayacc specification file in general can be found in [Ref. 4]. The following 
sections explain the most important aspects in the specification file. The specification file is 
given in Appendix C. 

b. Associating Ada Types with the Grammar Symbols: type YYSType 

Ayacc provides a way to associate an Ada data type with nonterminals and 

tokens. The data type is defined by associating an Ada type declaration with the identifier 
YYSType. Once this type is defined, actions can access the values associated with the grammar 
symbols. This declaration appears in the tokens section of the ayacc specification file. 

We declared YYSType as a record with discriminants. This provides a way to use 
pseudo-variable notation ($$) to denote the values associated with non-terminal and token 
symbols. This makes possible use of ayacc's internal stack to associate actions that are 
attached to the grammar rules with the tokens of different type when they are recognized. The 
declaration of YYSType is shown in Figure 4.5. The types used here are defined in the package 
PsdLConcrete_Type. 



45 



type TOKEN_CATEGORY_TYPE is(INTEGER_LITERAL, 

PSDL_ID_.STRING, 

EXPRESSI0N_STRING, 

TYPE_NAME_STRING, 

TYPE_DECLARATION_STRING, 

TIME_STRING, 

timer_op_id_string, 

NO^VALUE ); 

type YYStype (Token_Category : TOKEN_CATEGORY_TYPE := NO.VALUE) is 

record 

case Token_Category is 
when INTEGER_LITERAL => 
lnteger_Value ; INTEGER; 

when PSDL_ID_STRING => 

PsdlJd_Value : PsdIJd; 

when TYPE_NAME_STRING r> 

Type_Name_Value :Type_Name; 

when TYPE_DECLARATION_STRING r> 

Type_Declaration_Value : Type_Declaration; 

when EXPRESSION_STRING => 

Expression_Value : Expression; 

when T1ME_STRING => 

Time_Value : Millisec; 

when TIMER_OP_ID_STRING => 

Timer_Op_ld_Value : Tlmer_Op_ld; 

when NO_VALUE => 

White_Space : Text := Empty_Text; 

end case; 
end record; 






I 






i 

i 



Figure 4.5 The Declaration of YYSType 



c. Data Structures Used in the Actions 

We declared one global variable corresponding to each field in the 
Psdl_Component record, to hold their values until a call is made to constructing operation in 
the PSDL ADT. After tliis call is made, we reset their values back to their default values as 
specified in the PSDL ADT. 
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We also used several data structures and abstract data types to store the 
aggregate values temporarily. These are: 

• sets, 

• sequences, 

• stacks 

We used sets when we needed temporary storage to hold the tokens read but the 
order of those tokens is not important. For instance, in Figure 4.6 (where a fragment of PSDL 
code and correspondingayacc specification is shown), the order of IDENTIFIERS is not important. 



CONTROL CONSTRAINTS 

OPERATOR navigation_system 

OUTPUT CPA, bearing, trackjd, datum IF range < 5000 



con at ra int_opt ions 

: constraint_options OUTPUT_TOKEN 

{ 

The_Id_Set Empty_Id_Set ; 

The_Expression_String : =Expression (A_St rings . Empty) ; 
The_Output_Id . Op := The_Operator_Name; 

} 

id_list IF_TOKEN 

{ The_Expression_String := Expression (A_Strings . Empty ); } 

expression reqmt s_trace 

{ 

declare 

procedure Loop_Body(Id : Psdl_Id) is 
begin 

The_Output_Id . Stream := Id; 

Bind_Out_Guard ( The_Output_Id, The_Expression_St ring, 
The_Out_Guard) ; 

end Loop_Body; 
procedure Execute_Loop is 

new Id_Set_Pkg . Generic_Scan (Loop_Body ) ; 

begin 

Execute_Loop (The_Id_Set ) ; 
end; 

} 



I 



w 

Figure 4.6 The Use of sets in the Semantic Actions 



so we add each IDENTIFIER in a set (tliis is done in the production id_list), and when we are 
done reading we process each member of the set. In this case the sets are used to avoid the need 
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for lookahead or multiple passes. In Figure 4.6, we have to bind each IDENTIFIER in the set to 
an expression that is not known at the time the IDENTIFIER is scanned, because the expression 
occurs later in the input files. This technique is known as “back patching’’ in compiler design. 
The Ada code for a generic set is given in Appendix L. 



When the order of the tokens read is important for later processing we use 
sequences (defined in Appendix N) for temporary storage. A similar example to the one we gave 
for set case, is given in Figure 4.7. Here, the order of state declarations is important because 
the initialization of the states are given in an order corresponding to the order of declarations. 



OPERATOR weaponsjnterface 

SPECIFICATION 

STATES 

ciws_status, 

gun_status, 

sonar_status, 

ecm_status : weapons_status_type INITIALLY ready, loaded, ready, passive 

END 



attribute : 

I STATES_TOKEN 

{ 

Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack, 

Empty_Type_Declaration) ; 
Id_Seq__Pkg . Empty ( The_Id_Seq) ; 

} 

1 i a ^t ype_de cl 

{ 

Type_Decl_Stack_Pkg . Pop (The_Type_Decl_Stack , The_State) ; 
The_Init_Map_Id_Seq := The_Id_Seq; 

} 

INITIALLY_TOKEN 

{ 

Init_Exp_Seq_St ack_Pkg . Push (The_Init_Exp_Seq_Stack, 

Empty_Exp_Seq) ; 

The_Expression_St ring := Expression (A_Strings . Empty ) ; 

} 

initial^expreasion^liat 

{ 

Init_Exp_Seq_Stack_Pkg . Pop (The_Init_Exp_Seq_St ack, 

The_Init_Expr_Seq) ; 

Bind_Initial_St ate (The^State, The_Init_Expr_Seq, 
The_Initial_Expression) ; 

} 






I 






Figure 4.7 The Use of sequences in the Semantic Actions 

and at the time we read the state declarations, the initializations are not known. So we need 
to hold these declarations in a buffer in the order that they are read. We use the same 
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technique for the initial_expression. When the whole rule is parsed, we do the binding of each 
state to the corresponding initial_expression. 



Another data structure we used frequently in the parser is the stack, one of the 
most essential data structures in every compiler, operating system, editor, and many other 
applications. The Ada code for sl generic stack is given in Appendix O. The need for using a stack 
arises when there are nested read and write operations, (i.e, when there is a set of read and 
write operations and between a write and the corresponding rearf, as it is shown in Figure 4.S). 

wTnte read 




Figure 4.8 The Nested read and write Operations 



Tliis technique is especially convenient when there are recursive rules in the 
grammar. The parser uses a stack to hold or to stack the input tokens for later use. Initially 
the stack is empty, and we push the first “object” that needs to be held onto the stack, then we 
if need to “hold” some other objects before the first object is processed, we push and pop them. 
After each pair of push-pop operation the content of the stack becomes the same as it was before 
the push. 

Let us now illustrate the above thought with a typical structiue in the PSDL 
grammar. One good example is the evaluation of the initial_expression as a string that 
we used in Figure 4.7 for state initialization. Figure 4.9 shows a fragment of ayacc specification 
and corresponding PSDL source lines. In this example, we have an expression of the familiar 
type, grouped and nested using left and right parentheses. The expression inside first pair of 
parentheses is another initial_expression_list, and should be parsed by the 
corresponding rule again. If we do not save the contents of the previous sequence (TN.On in the 
sample input file at the top of Figure 4.9), it will be overwritten by the next value generated by 
a nested sub-expression (wp1 in Figure 4.9). To work around this problem, we use a temporar>^ 
sequence, and put the value of the expression in this sequence, and push the sequence onto the 
stack. 
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OPERATOR weaponsjnterface 

SPECIFICATION 

STATES 

ciws_status, 

gun_status, 

ecm_status : weapons_status INITIALLY ON, loaded, TN.On(wp1, TR.OFF(Wp2)) 

END 



initial_expression_list 

: initial_expreasion__liflt ' , 



{ 



initial^expresflion 



Init_Exp_Seq_Stack_Pkg .Pop ( The_Init_Exp_Seq_Stack, 

Temp_Init_Expr_Seq) ; 

Exp_Seq_Pkg . Add ( $4 . Expression_Value , Temp_Init_Expr_Seq) ; 
Init_Exp_Seq_Stack_Pkg .Push ( The_Init_Exp_Seq_Stack, 

Temp_Init_Expr_Seq) ; 



} 



init:ial_expre salon 



type_name 



IDENTIFIER 



{ 



The_Expression_String := The_Expression_String & " 

Expression (The_Id_Token) ; 
$$ ;= (Token_Category => Expression_St ring, 

Expression_Value => The_Expression_St ring) ; 



} 

j type^name 



IDENTIFIER 



{ 



} 



$$ := (Token_Category => Expression_String, 

Expres sion_Value => The_Expression_String & 

Expression (The_Id_Token) ) ; 



' (' 

{ Init_Exp_Seq_Stack_Pkg . Push (The_Init_Exp_Seq_Stack, 

Empty_Exp_Seq) ; } 

init:ial_exprossion_list ' ) ' 



{ 



Init_Exp_Seq_Stack_Pkg .Pop (The_Init_Exp_Seq_Stack, 

Temp_Init_Expr_Seq) ; 

The_Expression_String := Expression (A_Strings . Empty ) ; 
for i in 1 .. Exp_Seq_Pkg . Length (Temp_Init_Expr_Seq) loop 

if i > 1 then 

The_Expression_String : = The_Expression_String & 
end if; 

The_Expression_String := The_Expression_St ring & 

Exp_Seq_Pkg . Fetch ( Temp_Init_Expr_Seq, i) ; 

end loop; 

Exp_Seq_Pkg . Recycle ( Temp_Init_Expr_Seq) ; — throw it away 
$$ := (Token_Category => Expression_St ring, 

Expression_Value => $ 4 . Expression_Value & "(" & 
The_Expression_String & 



Figure 4.9 The Use of stacks for Evaluating the String Value of Expressions 
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When we evaluate the expression in the first pair of parentheses, we use the sequence at the 
top of the stack and add new expression to the content of the sequence. We assign the content 
of the sequence to the value of this production ($$) to be used by the parent rule, and we reclaim 
the heap space used by the temporary sequence. The evaluation of the expression in the second 
(more deeply nested) pair of parentheses is done in the same way. 

In addition to the data structures we mentioned above, we made use of the 
internal stack provided by ayacc to evaluate the productions. In the cases similar to the one 
above, the internal stack is not sufficient. As it can be seen from the specification of the 
example given above, the internal stack is being also used. Another typical case is the rule 
list_of_type_declaration, where there are multiple recursive productions. We used 
stacks in a similar way to evaluate these productions. 

d. User Supplied Ada Code in the Ayacc Specifications 

The Ada code (package Parser) at the end of the ayacc specification file is 

composed of: 

• Global variable declarations corresponding to each field in the record 
Psdl_Component, for the types defined in package PsdLConcrete_Type_Pkg, other 
temporary variables. 

• Generic package instantiations. 

• Generic procedure renaming. 

• Ada local subprograms that are used in the actions. These are simple routines used 
to modularize the code and to improve the readability. Their functionality is clear 
from the Ada code and the comments associated with them. 

• procedure YYParse, a parameterless procedure declaration for the main parsing 
procedure with the key marker, ## in the package body. The body of YYParse is 
generated by ayacc, and inserted where the marker is located. 

• procedure YYError, an error reporting procedure. It takes a string, defaulted to 
“Syntax Error”, corresponding an error message, as an argument. YYError is 
automatically called by the parser when it detects a syntax error. 
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procedure Get is the driver procedure of the parser, and explained in the next 
section. 



e. Ada Compilation Units Generated by Ayacc 

Ayacc generates four Ada compilation units (packages) in four files, from the 
input specification file psdl . y . A brief description of each of these follows: 

• psdl .a: This is the primary output of ayacc and contains the procedure YYParse 
along with the Ada code we provided in the “optional user declarations” section of 
psdl . y. The file psdl . a is given in Appendix U. 

• psdl_tokens .a: This file contains package Psdl_Tokens which provides the type 
and variable declarations needed by both the parser procedure YYParse and lexical 
analyzer function YYLex. This package is extracted from the “declarations” section 
of the ayacc specification file, and provides a way to associate PSDL concrete types 
with nonterminals and tokens used in the specification file, to be able to use $$ 
convention in the semantic actions. Tliis type association is done via the type 
YYSType (see Chapter TV, Section B.2.a), a record with discriminants which has 
fields for the value of each different token that we use in the semantic actions. The 
package is given in file psdl_tokens . a (Appendix X). 

• psdl_shift_reduce . a and psdl_goto.a: These two files contain the static 
parser tables used by YYParse, and are given in Appendices V and W. 

C. GET OPERATION 

The procedure Get provided in the package Parser is nothing but a driver procedure for 
the parser. We overloaded the standard Ada procedure name Get. The first Get procedure reads 
the standard input. The other Get procedure takes a string as the input file name. The syntax 
errors are displayed on the standard output with the line numbers and the string representing 
the most recent token read. 

To provide a standard I/O package, we wrote an I/O package Psdl_IO. This package con- 
tains the renaming of these two procedure and a Put procedure that is explained in the next 
section. Package PsdMO is given in Appendix E. 



D. EXPAND OPERATION 

In this implementation of the expander only the implementation of transformation of the 
graph portion of the PSDL specification is done. The implementation of the propagation of the 
timing constraints is left for future research. 
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The expansion of the graph is done level by level and in three passes for each node in one 

level. 

• Replace the node with the nodes in the sub-graph 

• Connect the edges 

• Connect input/output streams to the expanded graph 

In the first pass, each vertex or operator at the top level data-flow graph is expanded or 
replaced by the vertices in its corresponding subgraph. 

After the vertices replaced, in the second pass, the edges (streams) are connected (added) 
to those vertices. Actually the process is done at the first and second passes is nothing but re- 
placing the vertex with the corresponding subgraph. But since, there is no such operation pro- 
vided with the PSDL ADT, we have to realize this process in two passes. An enhancement can 
be done to the PSDL ADT to provide this operation directly. 

In the tliird pass external interfaces to the vertices are connected (input and output 
streams). The problem here is to decide where the input and streams are going to be connected. 
This information is taken from the specification part of the composite operator that has been 
expanded. 

The above process is repeated for each vertex in one level. After all the vertices are re- 
placed with their corresponding sub-graphs, each vertex in the resulted expanded level is 
checked if it is has a decomposition or if it is composite. If there are operators which are com- 
posite, then each composite operator is expanded in the same way by using the process ex- 
plained above. This “level by level” expansion is done till all the levels have only atomic oper- 
ators, except the top-level, which is the root operator. 

E. Pt/T OPERATION 

The Put operation is implemented as one of the operations in PSDL ADT. Although this 
operation did not exist in the original specification of the PSDL ADT written by Berzins, it is 
reasonable and useful to keep the I/O operations within the PSDL ADT. The other advantage 
is the ease of implementation. Since access to the private part is allowed only witliin the body 
of the package, each attribute of the Psdl_Component is obtained by the “dot notation” of Ada. 
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We implemented the put operation as a separate procedure of package Psdl_Component_Pkg. It 
is composed of several nested procedures to provide a suitable solution for converting the Ada 
representation of the expanded PSDL program into a formatted or pretty printeA PSDL source 
file. The body of the procedure is shown in Figure 4.10 as a pseudo-code. 



(1) foreach [( Id: Psdl_ld; Cp: Component_Ptr) in The_Psdl_Program ] loop 

(2) Component := Component_Ptr.all; /* dereferencing the pointer V 

(3) Put_Component_Name ( Component) ; 

(4) if Component is Psdl_Operator then 

(5) Put_Operator_Specification ( Component ); 

(6) Put_OperatorJmplementation ( Component ); 

(7) else /* a Psdl Type 7 

(8) Put_Type_Specification ( Component ); 

(9) PuLTypeJmplementation ( Component ); 

(10) end if; 



Figure 4.10 The Body of Put Operation 



For the implementation of the foreach construct shown in Figure 4.10, the m4(l) macro 
preprocessor of UNIX is used. Implementation of this transformation from foreach notation into 
the equivalent Ada representation is done by using a set of m4 macros, and a generator [Ref. 
17]. This provides an easy way to use the generic^scan procedure to scan the all pairs in the 
map representing the PSDL program. Since each pair is composed of an id and a pointer to Ps- 
dl_Component, the lines 2-10 in Figure 4.10 are executed for each pair. 

Lines 3, 5, 6, 8, and 9 are procedure calls. Line 3, Put_Component_Name is easy to imple- 
ment and is basically outputs the name attribute of the component with the suitable keyword 
TYPE or OPERATOR depending of the component's category and suitable formatting characters. 
The implementations of the other foiu* procedures are not that easy, since complex data struc- 
tures like maps, sets, graphs are involved in the Ada representation of corresponding at- 
tributes in the Psdl_Component record. We use the same technique to extract the elements or 
attributes of these data structures or abstract data types as we did with the Psdl_Program in 
the above paragraph. And we add some formatting characters to give a pretty printeA look to 
the extracted PSDL output. 



54 



In the case of the graph attribute of the Psdl_Component we use the attribute query op- 
erations provided by the Psdl_Graph ADT, to extract the attributes of the graph. 

The put operation is in file psdl_put . a and is given in Appendix H. 

Like we did with the get operation, to provide a standard way for Psdl I/O, we renamed 
procedure Put_Psdl in package PsdLlo as procedure Put. 

The output is written to standard output, unless the output is redirected to a file with 
switch ~o and a file name at the invocation of the expander. The output file is a pretty printed 
legal PSDL specification ready to be processed by the other tools in CAPS. 

F. INVOCATION OF THE PSDL EXPANDER 

The PSDL expander is a stand-alone program and is invoked on the command line. The 
command syntax is: 

expander [input-file] [-h] [-o output-file] 

When no arguments are provided, the expander reads the standard input, and outputs 
to the standard output. If the standard output is the keyboard is used to signal end of in- 
put.The input to expander can be piped through the output of another program. 

The -h switch prints a short message describing the usage of the expander command. 

The default output file for expander is the standard output. The switch -o with a file 
name directs the output to a UNIX file. If the -o switch is used the output file should have 
write permission if the file already exists or the directory should be “writable” . Otherwise ex- 
pander will abort with an error message: 

Error: can't create output file. Permission denied. 



Each time the expander is invoked a listing of the input file is created in the directory 
that the input file exists or if the input is standard input, in the current working directory 
when the expander is invoked. The name of the listing file will be st din .psdl . 1st for the 
standard input, or a pipe. If the input file is specified on the command line, then the name of 
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the listing file will be the concatenation of the name of the input file and “ . 1st”. If the directory 
is not “writable” then expander will abort with an error message like the following: 

Error: can't create listing file. Permission denied. 
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V. CONCLUSIONS AND RECOMMENDATIONS 



A. SUMMARY 

Tliis thesis research has contributed towards the development of a “better"’ CAPS envi- 
ronment by providing a tool that can supports hierarchically structured PSDL prototypes, to 
simplify prototyping of large and complex systems. 

The current implementation of the Execution Support System within CAPS is limited to 
hierarchically structured PSDL specifications with at most two levels. There has been a need 
to translate a multi-level PSDL source code into a two-level one to extend the domain of the 
entire system by providing a tool that can do tliis translation. 

Our work has been the first attempt to make liierarcliically structured multi-level PSDL 
programs available for the CAPS, and to provide a modular/top-down prototype development. 
We designed and implemented a PSDL expander that translates a PSDL prototype with an ar- 
bitrary depth hierarchical structure into an equivalent two-level form that can be processed by 
the other CAPS tools with their current implementations. 

The two issues studied in expanding the multi-level PSDL source code: 

• Transformation of the data-flow graph, 

• Propagating the timing constraints into the new representation. 

We did the design and implementation of the transformation of the data-flow graph by 
replacing all composite operators with their corresponding subgraphs with only atomic opera- 
tors by preserving the data-flow streams. 

We provided a partial design for propagating the timing constraints into the expanded 
form of the PSDL program. The implementation of tliis part the design is left for future re- 
search. 

As part of our research we designed and implemented a PSDL abstract data type repre- 
senting the whole PSDL program. The PSDL ADT provides an abstract representation of a 
PSDL program in Ada, all of the necessary operations, and all of the supporting types associ- 
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ated with it. The PSDL ADT makes the interface between the various CAPS tools cleaner by 
hiding unnecessary implementation details, thus providing a common input/output facility. 

We used a LALR(l) parser to parse the PSDL specification to construct the PSDL ADT. 
We generated the parser by using the tools ayacc and aflex, a parser generator and a lexical 
analyzer developed at University of California Irvine as part of the Arcadia Project. 

This research did not provide any work for expanding the PSDL specifications including 
DataTypes, and is recommended for a future thesis project. 



B. RECOMMENDATIONS FOR FUTURE WORK 

This thesis research has provided an initial design and implementation of the PSDL Ex- 
pander and PSDL ADT. Further research is needed to complete full implementation of the ex- 
pander, and identify the potential weaknesses. We recommend future work in the following 
specific areas: 

• The design and implementation of an efficient method for inheritance of timing 
constraints and static consistency checking. 

• The design and full implementation of a consistency checker that will pinpoint 
possible inconsistencies in the timing constraints between various levels of a PSDL 
program. 

• Improving the capabilities of the PSDL expander by adding the ability to expand 
the PSDL programs containing PSDL Types, 

• Enhancement of the PSDL ADT by providing more semantic checks and 
exceptions, adding the missing attributes (i.e., by requirements clauses) to the 
definition of type PsdLComponent, and more operations to access the attributes 
directly (for example, the existing operations are not well suited to implement the 
put operation as a stand-alone procedure, and because of the Put procedure was 
implemented as part of the PSDL ADT). 

• Improvement of PSDL graph ADT by adding exception handlers and more 
operations. The current implementation does not provide any exception handling. 

• Adding an error recovery scheme (for syntax errors) to the PSDL parser. The 
current implementation does not have an error recovery scheme, and the parser 
aborts at the first syntax errors encountered by signalling the line number and the 
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erroneous token read. Dain’s study can be a good reference for realizing an error 
recovery scheme for the PSDL parser [Ref. 27]. 

C- CRITIQUE OF AYACC AND AFLEX 

The current interface between ayacc and afLex complicates programming considerably be- 
cause of the possibility that the parser may have to read a lookahead token in order to deter- 
mine which production to reduce. This results in hard-to-predict behavior and considerably 
complicates the code in the semantic actions. 

A cleaner design would allow the tokens returned by the lexical analyzer to have 
attributes (such as the matching but currently retunied by YYtext, the current line number, 
or the current column number). This would require the introduction of a user defined type 
XXSType in the lexical scanner that is analogous to the YYSType currently provided by the 
parser. Currently the token type is an Ada enumeration type whose definition is generated by 
the tools and is beyond the user’s control. 

This recommendation also applies to the UNIX tools lex and yacc. 
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APPENDIX A. PSDL GRAMMAR 



This grammar uses standard symbology conventions.Optional items are enclosed 
in [ square brackets ]. Items which may appear zero or more times appear in { curly 
braces }. Terminal symbols appear in bold face. Groupings appear in ( parentheses ). 
Items contained in “double quotes” are character literals, the “ I ” vertical bar 
indicates a list of options from which no more than one item may be selected. This 
grammar represents the current version of the PSDL grammar as of 1 September 
1991. All previous versions are obsolete. 



start = psdl 
psdl 

= {component} 

component 

= data_type 
I operator 

data_type 

= tyqje id type_spec type_impl 

type_spec 

= specification [generic type_decl] [type_decl] 
operator id operator_spec} 

[functionality] end 

operator 

= operator id operator_spec operator_impl 
opera tor_spec 

= specification [interface] [functionality] end 

interface 

= attribute [reqmts_trace] 

attribute 

= generic type_decl 
I input type_decl 
I output type_decl 

I states type_decl initially initial_expression_list 



64 



I exceptions id_list 
I maximum execution time time 



type_decl 

= id_list type_name id Jist type_name} 



type_name 

= id 

I id “[“ type_decl “]” 

id_list 

= id id} 
reqmts_trace 

= by requirements id_list 
functionality 

= [ke>"words] [informal_desc] [fomial_desc] 

keywords 

= keywords idjist 

informal_desc 

= description text “}” 

formal_desc 

= axioms text “)” 



t3q)e_impl 

= implementation ada id end 

I implementation type_name {operator id operatorjmpl} end 
operator_impl 

= implementation ada id end 
I implementation psdl_impl end 



psdl_impl 

= data_flow_diagrani [streams] [timers] [controLconstraints] 
[informaLdesc] 



data_flow_diagram 

= graph [vertex] {edge} 



vertex 

= vertex op_id [“:” time] 

- time is the maxiimun execution time 
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edge 

= edge id time] op_id op_id 
— time is the latency 

op_id 

= id [T [id_Hst] “I ” [idjist] “)”] 

streams 

= data stream type_decl 

timers 

= timer id_list 
control_constraints 

= control constraints constraint {constraint} 



constraint 

= operator op_id 

[triggered [trigger] [if expression] [reqmts_trace]] 
[period time [reqmts_trace]] 

[finish within time [reqmts_trace]] 

[minimum calling period time [reqmts_trace]] 
[maximum response time time [reqmts_trace]] 
(constraint_options} 

constraint_options 

= output idjist if expression [reqmtsjrace] 

I exception id [if expression] [reqmts_trace] 

I timer_op id [if expression] [reqmts_trace] 



trigger 

= by all idjist 
I by some idjist 

timer_op 

= reset timer 
I start timer 
I stop timer 

initial_expression_list 

= initial_expression initial_expression] 

initial_expression 
= true 
I false 

I integerjiteral 
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I real_literal 
I stringjiteral 
I id 

I type_name id [“(“ iiiitial_expression_list “)”] 

I “(“ initiaLexpression “)” 

I initial_expression binary _op initiaLexpression 
I unary _op initiaLexpression 



binary_op 

= and I or I xor 

I I I ” I ” I I ” 



I “+” I I I I T I mod I rem I “**” 



unary_op 

= not I abs I I “+” 

time 

= integerjiteral unit 

mut 

= microsec 
I ms 
I sec 
I min 
I hours 

expression_list 

= expression expression} 

expression 

= true 
I false 

I integer_literal 
I time 

I reaLliteral 
I string_literal 
I id 

I type_name id [“(“ expression_list “)”] 

I “(“ expression “)” 

I initiaLexpression binary _op initial_expression 
I maary_op initiaLexpression 

id 

= letter {alpha_nmiieric} 
reaLliteral 

= integer_literal integer_literal 
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integer_literal 

= digit {digit} 

string_literal 

= {char} “““ 

char 

= any printable character except “}” 

digit 

= “0 .. 9 " 

letter 

= “a .. z” 

I “A .. Z” 



alpha_numberic 
= letter 
I digit 

text 

= {char} 
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APPENDIX B. AFLEX SPECIFICATION FOR PSDL 



psdl_lex.l 



Unit name 
File name 
Author 
Address 
Date Created 
Last Update 



Aflex specification file for PSDL parser 

psdl_lex . 1 

Suleyman Bayramoglu 

bayram0 taurus . cs . nps . navy .mil 

May 1991 

{Wed Oct 24 23:53:05 1990 - bayram} 



Machine/System Compiled/Run on 



Sun4 , SunOS 4.1, 

Aflex Ver. 1.1 (May 1990) 



— Keywords : lexical analyzer, parser, PSDL 

— Abstract : 

THis file is the Aflex input file for PSDL grammar, 

-- For more information 

— refer to the file psdl_lex . prologue 

Revision history 

— ^Source : /n/gemini/work/bayram/AYACC/parser/RCS/psdl_lex . 1, v $ 
— ^Revision: 1.13 $ 

— $Date: 1991/09/24 04:51:13 $ 

--$Author: bayram $ 



— Definitions of lexical classes 

Digit [0-9] 

Int {Digit}+ 

Letter [a-zA-Z_] 

Alpha ( (Letter) | {Digit } ) 

Blank [ \t\n] 

Text ["'{}] 

StrLit ['^"W] I [\\] ["\\] 
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Quote [ " ] 



ada I Ada I ADA 
axioms I AXIOMS 

by{Blank}+all |BY{Blank}+ALL 
by ( Blank ) + requirements | BY { Blank } 

by { Blank } +some I BY { Blank ) +SOME 
control I CONTROL 
constraints | CONSTRAINTS 
data I DATA 
stream! STREAM 
description | DESCRIPTION 
edge I EDGE 
end I END 



{ MYECHO; return (ADA_TOKEN) ; } 

{ MYECHO; return (AXIOMS_TOKEN) ; ) 

{ MYECHO; return (BY_ALL_TOKEN) ; ) 

+REQUIREMENTS {MYECHO; return (BY_REQ_TOKEN) ; ) 

{ MYECHO; return (BY_SOME_TOKEN) ; } 

{ MYECHO; return (CONTROL_TOKEN) ; ) 

{ MYECHO; return (CONSTRAINTS_TOKEN) ; } 
{ MYECHO; return (DATA_TOKEN) ; } 

{ MYECHO; return (STREAM_TOKEN) ; } 

( MYECHO; return (DESCRIPTION_TOKEN) ; } 
{ MYECHO; return (EDGE_TOKEN) ; } 

{ MYECHO; return (END TOKEN) ; } 



exceptions I EXCEPTIONS { MYECHO; return (EXCEPTIONS_TOKEN) ; } 

exception I EXCEPTION { MYECHO; return (EXCEPTION_TOKEN) ; } 

finish I FINISH { MYECHO; return (FINISH_TOKEN) ; } 

within I WITHIN { MYECHO; return (WITH IN_TO KEN ) ; } 

generic! GENERIC { MYECHO; return (GENERIC_TOKEN) ; } 

graph! GRAPH { MYECHO; return (GRAPH_TOKEN) ; } 

hours! HOURS { MYECHO; return (HOURS_TOKEN) ; } 

if! IF { MYECHO; return (IF_TOKEN); ) 

implementation ! IMPLEMENTATION { MYECHO; return ( IMPLEMENTATION_TOKEN) ; ) 
initially ! INITIALLY { MYECHO; return (INITIALLY_TOKEN) ; ) 

input! INPUT { MYECHO; return (INPUT_TOKEN) ; } 

keywords (KEYWORDS { MYECHO; return (KEYWORDS_TOKEN) ; ) 

maximum (MAXIMUM { MYECHO; return (MAXIMUM_TOKEN) ; } 

execution ! EXECUTION { MYECHO; return (EXECUTION_TOKEN) ; ) 

time (TIME { MYECHO; return (TIME_TOKEN) ; ) 

response (RESPONSE { MYECHO; return (RESPONSE_TOKEN) ; } 

microsec I MICROSEC I microseconds I MICROSECONDS { MYECHO; return (MICROSEC_TOKEN) ; } 

minimum (MINIMUM { MYECHO; return (MINIMUM_TOKEN) ; } 

calling{Blank)+period| CALLING (Blank }+PERIOD (MYECHO; return (CALL_PERIOD_TOKEN) ; ) 
min (MIN (minutes (MINUTES { MYECHO; return (MIN_TOKEN) ; } 

ms (MS (milliseconds (MILLISECONDS ( MYECHO; return (MS_TOKEN) ; } 

operator (OPERATOR { MYECHO; return (OPERATOR_TOKEN) ; } 

output (OUTPUT { MYECHO; return (OUTPUT_TOKEN) ; } 

period (PERIOD { MYECHO; return (PERIOD_TOKEN) ; } 

reset (Blank }+timer ( RESET {Blank l+TIMER (MYECHO; return (RESET_TOKEN) ; } 

sec ( SEC ( seconds ( SECONDS { MYECHO; return (SEC_TOKEN); } 

specification ( SPECIFICATION (MYECHO; return (SPECIFICATION_TOKEN) ; } 

start (Blank)+timer ( START(Blank}+TIMER { MYECHO; return (START_TOKEN) ; } 
states ( STATES { MYECHO; return (STATES_TOKEN) ; } 

stop(Blank}+timer (STOP(Blank}+TIMER { MYECHO; return (STOP_TOKEN) ; } 
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timer I TIMER { MYECHO; return (TIMER_TOKEN) ; } 
triggered I TRIGGERED { MYECHO; return (TRIGGERED_TOKEN) ; } 
type I TYPE { MYECHO; return (TYPE_TOKEN) ; } 
vertex I VERTEX { MYECHO; return (VERTEX_TOKEN) ; ) 



"and" 


1 "AND" 


{ MYECHO; return 


(AND_TOKEN) ; 


) 


"or" 1 


"OR" 


{ MYECHO; return 


(OR_TOKEN) ; 


) 


"xor" 


1 "XOR" 


{ MYECHO; return 


(XOR_TOKEN) ; 


} 






{ MYECHO; return 


( CREATE R_THAN_OR_EQUAL) 






{ MYECHO; return 


(LESS_THAN_OR_EQUAL) ; 




ff ^~ff 


{ MYECHO; return 


(INEQUALITY) 


; } 


" _ > " 




{ MYECHO; return 


(ARROW) ; 


} 


\\ — ff 




{ MYECHO; return 


( '=' ) ; } 








{ MYECHO; return 


( '+' ) ; } 








{ MYECHO; return 


('-'); } 




ir n 




{ MYECHO; return 


('*'); } 




\\ j ff 




{ MYECHO; return 


('/'); } 








{ MYECHO; return 


('&'); } 




^ \^ 




{ MYECHO; return 


('('); } 




\\ J ff 




{ MYECHO; return 


(')'); } 




\\ ^ \\ 




{ MYECHO; return 


('['); } 




W j ff 




{ MYECHO; return 


(']'); } 




\\ . ff 




{ MYECHO; return 


(':'); } 




W ff 
f 




{ MYECHO; return 


(','); } 




W ff 




{ MYECHO; return 


('.'); } 




\\ 1 ff 




{ MYECHO; return 


('!'); } 




\\y ff 




{ MYECHO; return 


( '>' ) ; } 




\\ ^ >\ 




{ MYECHO; return 


('<'); 


} 


"mod" 


1 "MOD" 


{ MYECHO; return 


(MOD_TOKEN) 


} 


"rem" 


1 "REM" 


{ MYECHO; return 


(REM_TOKEN) 


} 


1 


"exp" 1 "EXP" 


{ MYECHO; return 


(EXP_TOKEN) 


} 


"abs" 


|"ABS" 


{ MYECHO; return 


(ABS_TOKEN) 


} 


"not" 


1 "NOT" 


{ MYECHO; return 


(NOT_TOKEN) 


} 


true 1 


TRUE 


{ MYECHO; return 


(TRUE) ; 


} 


false 1 FALSE 


{ MYECHO; return 


(FALSE) ; 


} 



{Letter} {Alpha) * { 

MYECHO; 

the_prev_id_token ;= the_id_token; 
the_id_token := to_a (psdl_lex_dfa . yytext ) ; 

return (IDENTIFIER); 

} 

{Quote) {StrLit} * {Quote} { 

MYECHO; 

the_string_token ;= to_a (psdl_lex_df a . yytext ) ; 
return (STRING_LITERAL) ; 

) 
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{Int} 



MYECHO/ 

the_integer_token := to_a (psdl_lex_dfa .yytext ) ; 
return (INTEGER_LITERAL) ; 

} 

{Int) "."{Int} { 

MYECHO; 

the_real_token to_a (psdl_lex_dfa . yytext ) ; 

return (REAL_LITERAL) / 

} 

"{"{Text}*"}" { 

MYECHO; 

the_text_token := to_a (psdl_lex_dfa . yytext ) ; 
return (TEXT_TOKEN) ; 

} 



[\n] { MYECHO; linenum; } 

[ \t] { MYECHO; null; } — ignore spaces and tabs 



%% — user supplied code 

— $Date: 1991/09/24 04:51:13 $ 

— $Revision: 1.13 $ 



with Psdl_Tokens, A_St rings, Psdl_Concrete_Type_Pkg; 
use Psdl_Tokens, A_St rings, Psdl_Concrete_Type_Pkg; 
use Text lo; 



Psdl Lex SPEC 



package Psdl_Lex is 

Lines : Positive := 1; 

Num_Errors : Natural := 0; 
List_File : Text_Io . File_Type ; 
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— in the case that one id comes right after another id 

— we save the previous one to get around the problem 

— that look ahead token is saved into yytext 

-- This problem occurs in the optional_generic_param if 



— an optinal type declaration 

— IDENTIFIER 

The_Prev_Id_Token : Psdl_Id 
The_Id_Token : Psdl_Id 

— STRING_LITERAL 
The_String_Token : Expression 

— INTEGER_LITERAL (psdl_id or 
The_Integer_Token : A_String 

— REAL_LITERAL 
The_Real_Token : Expression 

— TEXT_TOKEN 
The_Text_Token : Text 

Last_Yylength : Integer; 



comes after that. 

:= Psdl_Id (A_St rings .Empty) ; 

:= Psdl_Id (A_St rings .Empty) ; 

:= Expression (A_Strings .Empty) 

expression) 

:= A_St rings . Empty ; 

:= Expression (A_St rings . Empty ) 

:= Empty_Text; 



— This procedure keeps track of the line numbers in 

— the input file, by using the global variable "lines" 
procedure Linenum; 



— This procedure writes the input file ina file 

— <input-f ile> . 1st . 1st ' prepending the line numbers, 
procedure Myecho; 



-- Lexical analyzer function generated by aflex 
function YYlex return Token; 



end Psdl_Lex; 



Psdl Lex 



BODY 



procedure Myecho is 
begin 

Text_Io . Put ( List_File, Psdl_Lex_Df a . Yytext ) ; 
end Myecho; 



procedure Linenum is 
begin 

Text_Io .Put (List_File, Integer' Image (Lines) & " : / 
Lines := Lines + 1; 
end Linenum; 



end Psdl Lex; 
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APPENDIX C. AYACC SPECIFICATION FOR PSDL 



— psdl , y 



— Unit name 
-- File name 

— Author 

— Address 

— Date Created 

— Last Update 

— Machine /System 



: Ayacc specification file for PSDL parser 
; psdl . y 

: Suleyman Bayramoglu 

: bayram0taurus.cs.nps.navy.mil 
: May 1991 

: {Mon Sep 23 22:59:33 1991 ~ bayram} 

Compiled/Run on : Sun4, SunOs 4.1, Ayacc Ver. 



1.0 



(May 1988) 



— Keywords : parser, PSDL 

— Abstract : 

— THis file is the ayacc input file for PSDL grammar. For more information 

— refer to the file psdl . y . prologue 

Revision history 

— $Source; /n/gemini/work/bayram/AYACC/parser/RCS/psdl . y , v $ 

— $Revision: 1.1 $ 

— $Date; 1991/09/24 06:04:35 $ 

— $Author: bayram $ 



— / token declarations section */ 

%token ' ( ' ' ' [ ' '] ' ' : ' ' • ' ' T 

%token ARROW 

%token ARROW 

%token TRUE FALSE 

%token ADA_T0KEN AXI0MS_T0KEN 

%token BY_ALL_TOKEN BY_REQ_TOKEN BY_SOME_TOKEN 
%token CALL_PERIOD_TOKEN CONTROL_TOKEN 
%token CONSTRAINTS TOKEN 



75 



%t oken 


DATA_TOKEN DESCRI PT ION_TOKEN 


%t oken 


EDGE_TOKEN END_TOKEN EXCEPT IONS_TOKEN 


%t oken 


EXCEPTION_TOKEN EXECUTION_TOKEN 


%t oken 


FINISH_TOKEN 


%t oken 


GENERIC_TOKEN GRAPH_TOKEN 


%t oken 


HOURS_TOKEN 


%token 


IF_TOKEN IMPLEMENTATION_TOKEN 


%t oken 


INITIALLY_TOKEN INPUT_TOKEN 


%t oken 


KEYWORD S_TOKEN 


%t oken 


[■1AXIMUM_T0KEN MINIMUM_TOKEN 


%t oken 


MICROSEC_TOKEN 


%t oken 


MIN_TOKEN MS_TOKEN MOD_TOKEN 


%t oken 


NOT_TOKEN 


%t oken 


OPERATOR_TOKEN OR_TOKEN OUTPUT_TOKEN 


%t oken 


PERIOD_TOKEN 


%t oken 


RESET_TOKEN RESPONSE_TOKEN 


%t oken 


SEC_TOKEN SPECIFICATION_TOKEN 


%t oken 


START_TOKEN STATES_TOKEN STOP__TOKEN 


%token 


STREAM_TOKEN 


%t oken 


TIME_TOKEN 


%t oken 


TIMER_TOKEN TRIGGERED_TOKEN TYPE_TOKEN 


%t oken 


VERTEX_TOKEN 


%t oken 


WITHIN TOKEN 



%t oken 


IDENTIFIER 


%t oken 


INTEGER_LITERAL REAL_LITERAL 


%t oken 


STRING_LITERAL 


%t oken 


TEXT TOKEN 
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— /* operator precedences */ 

— /* left means group and evaluate from the left */ 

%left AND_TOKEN OR_TOKEN XOR_TOKEN LOGICAL_OPERATOR 

%left '<' '>' '=' GREATER_THAN_OR_EwUAL LE£S_THAN_OR_EQUAL INEQUALITY RELATIONAL_OPEPJ^TOR 

%left '+' BINARY_ADDING_OPERATOR 

%left UNARY_ADDING_OPERATOR 

%left V' MOD_TOKEN REM_TOKEN MULTIPLYING_OPERATOR 

%left EXP TOKEN ABS TOKEN NOT TOKEN HIGHEST PRECEDENCE OPERATOR 



%start start_symbol — this is an artificial start symbol, for initialization 



%with Psdl_Concrete_Type_Pkg; 
%use Psdl_Concrete_Type_Pkg; 



{ 

type TOKEN_CATEGORY_TYPE is ( INTEGER_LITERAL, 

PSDL_ID_STRING, 

EXPRESS ION__STRING, 

TYPE_NAME_STRING, 

T YP E_DE CLARAT I ON_ST RI NG , 

T1ME_STRING, 

TIMER_OP_ID_STRING, 

NO_VALUE) ; 

type YYStype ( Token_Category ; TOKEN_CATEGORY_TYPE := NO_VALUE) is 
record 

case Token_Category is 

when INTEGER_LITERAL => 

Integer_Value : INTEGER; 

when PSDL_ID_STRING => 

Psdl_Id_Value : Psdl_Id; 

when TYPE_NAME_STRING => 

Type_Name_Value ; Type_Name; 

when TYPE_DECLARATION_STRING => 

Type^Declaration_Value ; Type_Declaration ; 

when EXPRESSION_STRING => 

Expression_Value : Expression; 

when TIME STRING => 
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Time_Value : Millisec; 

when TIMER_OP_ID_STRING => 

Timer_Op_Id_Value ; Timer_Op_Id ; 

when NO_VALUE => 

White_Space : Text := Empty_Text; 
end case; 
end record; 



%% 

— /* package Psdl_Program_Pkg is /* 
— /* new Generic_Map_Pkg (Key => PSDL_ID, Result => COMPONENT_PTR) ; /* 
— /* type PSDL_PROGRAM is new Psdl_Program_Pkg . Map; /* 
— /* /* 
— /* type Component__Ptr is access PSDL_COMPONENT; /* 
— /* 

— /* A psdl program is an environment that binds /* 
— /* psdl component names to psdl component definitions. /* 
— /* The operations on psdl_programs are the same /* 
— /* as the operations on maps. /* 



st art_symbol 

{ The_Program := Empty_Psdl_Program; } 

psdl 



psdl 

psdl 

{ the_component_pt r ;= new PSDL_COMPONENT; } 

component 

{ 

— /* the created object should always be constrained */ 

since object is a record with discriminants . */ 

The__Component_Pt r : = 
new Psdl_Component 

(Category => Component_Category (The_Component ) , 
Granularity => Component_Granularity ( The_Component ) ) ; 

The_Component_Pt r . all := The_Component ; 

Bind_Program (Name (The_Component } , 

The_Component_Ptr , 

The_Program) ; 

} 

I — /* empty */ 
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component 



data_type 



operator 



-/ ’* subtype Data_Type 
(* (category => 

-/^ subtype Data_Type 
/■* (category => 



is PSDL_COMPONENT V 
PSDL_TYPE) 

is PSDL_COMPONENT */ 
PSDL OPERATOR) * i 



data_type 

TYPE_TOKEN IDENTIFIER 

{ 

$$ := (Token_Category => Psdl_Id_Str ing, 

Psdl_Id_Value => The_Id_Token) ; 

The_Operation_Map := Empty_Operation_Map; 

} 

type_spec type_impl 

{ 

-- construct the psdl type using global variables 

— psdl component record fields that have default values 

-- are passed as in out parameters, so that after 

— building tha component, they are initialized 

— back to their default values. 

Build_Psdl_Type ($3 . Psdl_Id_Value , 

The_Ada_NAme , 

The_Model , 

The_Data_Structure , 

The_Operat ion_Map, 

The_Type_Gen_Par , 

The_Keywords , 

The__De script ion, 

The_Axioms , 

I s_Atomic_Type , 

The_Component ) / 



type_spec 



SPECIFICATION_TOKEN opt ional_generic_param opt ional_type_decl 
op_spec_list functionality END^TOKEN 



“-/* C . Gen_Par : Type_Declaration : =Empty_Type_Declaration / 
optional_generic_param 

GENERIC TOKEN 
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{ 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack, 

Empty_Type_Declarat ion) ; 
Type_Spec_Gen_Par ;= TRUE; 

} 

list_of_type__decl 

{ 

Type__Decl_Stack_Pkg . Pop ( The_Type_Decl_Stack, 

The_Type_Gen_Par ) ; 
Type_Spec_Gen_Par := FALSE; 

} 

I — /* empty */ 



opt ional_type_decl 



{ 



} 



Type_Decl_Stack_Pkg . Push (The__Type__Decl_Stack , 

Empty_Type_Declaration) ; 



list_of_type_decl 



{ 



Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack, 

The Model ) ; 



op_spec__list 

: op_spec_list 

{ The_Op_Ptr := new Operator; } 
OPERATOR TOKEN IDENTIFIER 



$$ := (Token_Category => Psdl_Id_String, 

Psdl_Id_Value => The_Id_Token) ; 

— create a new operator (composite ) to put in ops map 

— make it composite because we don' t know what 

— the granularity is at this point. 



The_Op_Pt r 



} 



new Operator (Category => Psdl_Operator , 
Granularity => Composite) ; 



Operator_Spec 

{ 



Build__Psdl_Operator ( $5 . P ‘5dl_Id_Value , 
The_Ada_Name , 
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The_Gen_Par , 

The_Keywords, 

The_De script ion, 
The_Axioms, 

The_Input , 

The_Output , 

The^St ate , 

The_Initial_Expression , 
The_Except ions , 

The_Specif ied_Met , 
The_Graph, 

The_St reams, 

The_Timers , 

The_Trigger, 

The_Exec__Guard , 
The_Out_Guard, 

The_Excep_T rigger, 
The_Timer_Op, 

The__Per , 

The_Fw, 

The^Mcp, 

The_Mrt , 

The_Impl_Desc, 

Is_Atomic => False, 

The_Opr => The^Operator ) 

The_Op_Pt r . all := The_Operat or ; 

Bind_Operat ion ($5 . Psdl_Id_Value , 

The_Op_Ptr, 

The^Operat ion_Map) ; 

} 

I empty V 



operator 



OPERATOR_TOKEN IDENTIFIER 

{ 

$$ := (Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => The_Id_Token) ; 

) 



operat or_spec operat or_impl 

{ 

— construct the psdl operator 
-- using the global variables 
Build_Psdl_Operator ( $3 . Psdl_Id_Value , 
The_Ada_Name , 
The_Gen_Par , 
The_Key words , 
The_De script ion , 
The_Axioms , 
The_Input , 
The_Output , 
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The_State, 

The_Init ial_Expression, 
The_Exceptions , 
The_Specif ied_Met , 
The_Graph, 

The_St reams , 

The_Timers , 

The_Trigger, 
The_Exec_Guard, 
The_Out_Guard, 
The_Excep_T rigger, 
The_Time r_Op, 

The_Per, 

The_Fw, 

The_Mcp , 

The_Mrt , 

The_Impl_Desc, 

I s_Atomic_Operat or , 
The_Component ) ; 



operator_spec 

: SPECIFICATION__TOKEN 

interface functionality END_TOKEN 



interf ace 

: interface attribute reqmts_trace 
I — /* empty */ 



attribute 



— /* C.Gen_Par: Type_Declaration : =Empty_Type_Declaration 



: GENERIC TOKEN 






} 



Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack, 

Empty_Type_Declaration) ; 



li st_of_type_decl 

{ 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack , 

The_Gen_Par) ; 

} 

— /* 0. Input: Type_Declaration : =Empty_Type_Declaration */ 
I INPUT_T0KEN 
{ 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack, 

Empty_Type_Declarat ion) / 
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} 



li st_of_type_decl 

{ 

Type_Decl_Stack_Pkg . Pop (The_Type_Decl_Stack, 

The_Input) ; 



} 



— /* 0. Output: Type_Declaration : =Empty_Type_Declaration */ 

I 0UTPUT_T0KEN 



} 



Type_Decl_St ack_Pkg , Push (The_Type_Decl_Stack , 

Empty_Type_Declarat ion) ; 



li st_of _type_decl 

{ 



} 



Type_Decl_St ack^Pkg . Pop ( The_Type_Decl_Stack , 

The_Output) ; 



— /* 0. State: Type_Declarat ion : =Empty_Type_Declarat ion */ 

I STATES_TOKEN 

{ 

Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack , 

Empty_Type_Declaration) ; 
Id_Seq_Pkg . Empty (The_Id_Seq) ; 

— empty id seq, to use with init map 



li st_of_type_decl 

{ 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack , 

The_State) ; 

The_Init_Map_Id_Seq := The_Id_Seq; 

— hold the id's for init map. 



-- /■* O.Init: Init_Map : =Empty_Init_Map */ 

— /* Init_Map is Map(Psdl_Id, Expression) */ 

INITIALLY_TOKEN 

{ 

Init__Exp_Seq_Stack_Pkg .Push ( The_Init_Exp_Seq_St ack , 

Empty_Exp_Seq) ; 

The_Expres sion_String Expression (A_Strings . Empty ) ; 

} 

— /* Expression is new A_St rings . A_St ring */ 
init ial_expres sion_list 

{ 

Init_Exp_Seq_Stack_Pkg . Pop (The_I nit_Exp_Seq_St ack , 

The_Init_Expr_Seq) ; 
Bind_Initial_State (The_State, 

The_Init_Expr_Seq, 
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} 



The_Initial_Expression) ; 



— /* O.Excep: Id_Set:= Empty_Id_Set ; */ 

I EXCEPT IONS_TOKEN 

{ 

Id_Set_Pkg . Empty (The_Id_Set) ; 

} 

id_list 

{ 

Id_Set_Pkg .Assign (The_Exceptions, The_Id_Set) ; 

} 



— /'*' 0 . Smet : Millisec */ 

— /* everything is converted into msec * / 

I MAXIMUM_TOKEN EXECUT ION_TOKEN TIME_TOKEN time 

{ 

The_Specif ied^Met := $ 4 . Integer_Value; 

} 



— /* initialization is made by the callers of this rule */ 



li st_of_type_decl 

: li st_of_type_decl type_decl 

1 type_decl 



type_decl 

: { 

The_Id_Set := Empt y_Id_Set ; 

} 

id_list ' : ' 

{ 

The_Expression_String := The_Expression_String & " : 
Id_Set_Stack_Pkg . Push ( The_Id_Set_Stack, The_Id_Set) ; 

} 

type^name 

{ 

Type_Decl_Stack_Pkg . Pop (The_Type_Decl_Stack, 

Temp_Type_Decl) ; 

— / Bind each id in id the id set to the type name */ 

— /* in the internal stack ($5) , return temp_type_decl */ 
Bind_Type_Declaration ( 

Id_Set_Stack_Pkg .Top (The_Id_Set_Stack) , 

$5 . Type_Name_Value , 
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Temp_Type_Decl) ; 



Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack , 

Temp_Type_Decl) ; 



— /* pop the stack after bind */ 

Id_Set_Stack_Pkg . Pop (The_Id_Set_Stack) ; 



type_name 



: IDENTIFIER 



$$ := (Token_Category => Psdl_Id_String, 

Psdl Id Value => The_Id_Token) ; 



The_Expression_String := The_Expression_St ring & " ” 

& Expression (The_Id_Token); 



{ 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack , 



The_Expression_String := The_Expression_String & " ["; 



The_Type_Name . Gen_Par 

: = Type_Decl_Stack_Pkg . Top (The_Type_Decl_Stack) / 
$$ := ( Token_Category => Type_Name_St ring, 

Type_Name_Value => The_Type_Name) ; 
Type_Decl_Stack_Pkg . Pop (The_Type_Decl_Stack ) ; 



{ The_Expression_String := The_Expression_String & "] } 



— this an awkward way of working around the 

— problem we get when we have two identifiers 

— one after another 

if Type_Spec_Gen_Par and 



Empty_Type_Declarat ion) ; 



list_of _type_decl 



The_Type_Name 
The_Type_Name . Name 



:= New Type_Name_Record; 
:= $2 .Psdl_Id_Value; 



I IDENTIFIER 




then 
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Empty_Type_Declaration) ; 

The_Expression_String := The_Expression_String & " " 

& Expression (The_Prev_Id_Token) ; 

else 

The_Type_Name := 

New Type_Name_Record' (The_Id_Token, 

Empty_Type_Declaration) ; 

The_Expression_String := The_Expression_String & " " 

& Expression (The_Id_Token) ; 

end if; 



} 



$$ := (Token_Category 

Type_Name_Value 



=> Type_Name_St ring, 
=> The_Type_Name) ; 



id_list 

: id_list ' , ' 

{ The_Expression_String := The_Expression_String & ", " ; } 



IDENTIFIER 



{ 



} 



Id_Set_Pkg . Add (The_Id_Token, The_Id_Set) ; 

The_String := The_String & & The_Id_Token; 

Id_Seq_Pkg . Add (The_Id_Token, The_Id_Seq) ; 
The_Expression_String := The_Expression_St ring & " " 

& Expression (The_Id_Token); 



IDENTIFIER 



{ 



} 



Id_Set_Pkg . Add (The_Id_Token, The_Id_Set) ; 

The_String := The_Id_Token; 

Id_Seq_Pkg . Add (The_Id_Token, The_Id_Seq) ; 
The_Expression_String := The_Expression_String & " " 

& Expression ( The_Id_Token) ; 



reqmts_trace — Ignored In This Version 

: BY REQ TOKEN id list 



functionality 

: keywords inf ormal_desc formal_desc 
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keywords 

: KEYWORDS_TOKEN 

{ 

Id_Set_Pkg . Empty (The_Id_Set) ; 

} 

id list 



Id_Set_Pkg .Assign ( The_Keywords , The_id_Set) 

} 

{ The_Keywords := Empty_Id_Set ; } 



inf ormal_desc 

: DESCRIPTION_TOKEN TEXT_TOKEN 

{ 

The_Description := The_Text_Token ; 
The_Impl_Desc := The_Text_Token; 

} 

I 



f ormal^desc 

: axioms_TOKEN TEXT_TOKEN 

{ 

The_Axioms:= The_Text_Token; 

} 

I 



type_impl 

: IMPLEMENTATION_TOKEN ADA_TOKEN IDENTIFIER 

{ 

I s_Atomic_Type := True; 

The_Ada_Name := Ada_Id ( The_Id_Token) ; 



END TOKEN 



I IMPLEMENTATION_TOKEN type_name 

{ 

Is_Atomic_Type := False; 

The_Data_Structure := $2 . Type_Name_Value ; 



op_impl_list END_TOKEN 
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op_i mp 1_1 i s t 

: op_impl_list 

{ The_Op_Ptr := New Operator; } 

OPERATOR_TOKEN IDENTIFIER 

{ 

$$ := (Token_Category => Psdl_Id_String, 

Psdl_Id_Value => The_Id_Token) ; 



operator__impI 

{ 

-- add implementation part to the operator in the operation map 
Add_Op_Impl_To_Op_Map ($5 . P sdl_Id_Value , 

The_Ada_Name , 

Is_Atomic_Operator , 

The_Operat ion_Map, 

The_Graph, 

The_Streams, 

The_Timers , 

The_Trigger, 

The_Exec_Guard, 

The_Out_Guard, 

The_Excep_T rigger, 

Th e_T i me r_Op , 

The_Per , 

The_Fw, 

The_Mcp, 

The_Mrt, 

The_Impl_Desc ) ; 

} 



operat or_impl 

: IMPLEMENTATION_TOKEN ADA_TOKEN IDENTIFIER 

{ 

Is_Atomic_Operator := True; 
The_Ada_Name : = Ada_Id (The_Id_Token) ; 



END_TOKEN 

I IMPLEMENTATION_TOKEN psdl_impl 

{ 

Is_Atomic_Operator := False; 

} 

END TOKEN 



psdl_impl 

: data_f low_diagram streams timers cont rol_const raints 
{ The_Impl_Desc := Empty_Text; } 
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informal desc 



data_f low_diagram 

{ The_Graph := Empty_Psdl_Gr aph ; } 

GRAPH_TOKEN vertex_list edge_list 



— / Time Is The Maximum Execution Time *■ / 

vert ex_l ist 

: vertex_list VERTEX_TOKEN op_id opt ional_t ime 

{ 

The_Graph := Psdl_Graph_Pkg . Add_Vertex ($3 . Psdl_Id_Valu 
The_Graph, $ 4 . Integer_Value) ; 



I — /* empty 



— /* Time Is The Latency ^ / 

edge_list 

: edge_list EDGE_TOKEN IDENTIFIER 

{ The_Edge_Name := The_Id_Token; } 

opt ional_t ime op_id ARROW op_id 

{ 

The_Graph := P sdl_Graph_Pkg . Add_Edge ($ 6 . Psdl_Id_Value , 

$8 .Psdl_I devalue, 
The_Edge_Name , 
The_Graph , 

$5 . Integer_Va lue ) 

} 



op_id 

: IDENTIFIER 

{ 

$$ := (Token_Category => Psdl_Id_St ring , 

Psdl_Id_Value => The_Id_Token) ; 

} 



opt_arg 

{ 

$$ 



} 



Token_Category => Psdl_I d_St ring , 
Psdl_Id_Value => $2 . P sdl_Id_Value 

& $3 . Psdl_ Id_Value ); 
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opt_arg 



{ The_String := Psdl_Id (A_St rings . Empty ) ; } 

' ( ' optional_id_list 

{ 

$$ := ( Token_Category => Psdl_Id_String, 

Psdl_Id_Value => "(" & The_String) ; 
The_String := Psdl_Id (A_St rings . Empty ) ; 

} 



optional_id_list ')' 

{ 



$$ := ( 



} 



Token_Category => Psdl_Id_St ring, 
Psdl_Id_Value => $4 , Psdl_Id_Value 
& "1" & The_String 



& 



)" ) 



{ $$ 

} 



( Token_Category => Psdl_Id_St ring, 

Psdl__I devalue => Psdl__Id (A_St rings . Empty) ) 



optional_id_li st 
: id list 



optional_t ime 

: ' : ' time 

{ 

$$ := (Token_Category => Integer_Literal , 

Integer_Value => $ 2 . Integer^Value) ; 



{ $$: = 

} 



( Token^Category 
Integer_Value 



=> Integer_Literal , 

=> 0 ); 



streams 



DATA_TOKEN STREAM_TOKEN 

{ 



) 



Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack, 

Empty_Type_Declaration) ; 



list_of_type_decl 

{ 
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} 



Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_Stack , 

The_St reams) ; 



— / * The order of id's is not important, so 
— /* we use Id^Set as the data structure */ 

--/■*■ to store the timers. */ 



timers 



TIMER_TOKEN 

{ 

Id_Set_Pkg . Empty (The_Id_Set) ; 

} 

id_list 

{ 

Id__Set_Pkg .Assign (The_TimerS; The_Id_Set) ; 

} 

{ 

Id_Set_Pkg .Assign (The_Timers , Empty_Id_Set ) ; 

} 



control 



constraint s 

: CONTROL TOKEN CONSTRAINTS TOKEN 



{ 

The_Operator_Name := 
The_Trigger := 

The_Per := 

The_Fw := 

The_Mcp := 

The_Mrt := 

The_Exec_Guard := 

The_Out_Guard := 

The_Excep_Trigger := 
The_Timer_Op := 

} 

constraints 



The_Id_Token; 

Empty_Trigger_Map; 

Empty_Timing_Map; 

E mpt y_T im i ng_Map ; 

Empty_Timing_Map; 

Empty_Timing_Map; 

Empty_Exec_Guard_Map; 

Empty_Out_Guard_Map; 

Empty_Excep_Trigger_Map 

Empty_Timer_Op_Map; 



constraints 

: constraints OPERATOR_TOKEN IDENTIFIER 

{ 

The_Operator_Name := The_Id_Token; 

} 

Opt_Trigger Opt_Period Opt_Finish_Within 
Opt_Mcp Opt^Mrt Constraint_Options 
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1 OPERATOR_TOKEN IDENTIFIER 
{ 

The_Operat or_Name The_Id_Token; 

} 

Opt_Trigger Opt_Period Opt_Fini sh_Within 
Opt^Mcp Opt_Mrt 



const raint_opt ions 

: constraint_opt ions OUTPUT_TOKEN 

{ 

The_Id_Set := Empty_Id_Set / 

The_Expression_String := Expression (A_Strings . Empty) 
The___Output_Id . Op := The_Operator_Name ; 

} 

id_list IF_TOKEN 

{ 

The_Expres sion_String := Expression (A_Strings . Empty ) 

} 

expression reqmts_trace 

{ 



— Begin Expansion Of Foreach Loop Macro, 
declare 

procedure Loop__Body (Id : Psdl_Id) is 
begin 

The_Output_Id . Stream ;= Id; 
Bind_Out_Guard (The_Output_Id, 

The_Expres sion_String, 
The_Out_Guard ) ; 



end Loop_Body; 
procedure Execute_Loop is 

new Id_Set_Pkg . Generic_Scan (Loop_Body ) ; 

begin 

Execute_Loop (The_Id_Set) ; 
end; 

} 

I constraint_options EXCEPTION_TOKEN IDENTIFIER 

{ 

$$ := (Token_Category => Psdl_Id_String, 

Psdl_Id_Value => The_Id_Token) ; 
The_Expression_String ;= Expression (A_Strings . Empty ) 

} 

opt_if_predicate reqmts_trace 

{ 

The_Excep_Id . Op := The_Operat or_Name; 
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The_Excep_Id . Excep := $4 . Psdl_Id_Value; 
Bind_Excep_Trigger ( The_Excep_Id, 

The_Expression_St ring, 
The_Excep_Trigger) ; 



I const raint_opt ions timer_op IDENTIFIER 

{ 

$$ := ( Token_Category => Psdl_Id_String, 

Psdl_Id_Value => The_Id_Token) ; 

The_Expres sion_St ring := Expression (A_St rings . Empty ) ; 

} 

opt_if_predicate reqmts_trace 

{ 

The_Timer_Op_Record . Op_Id := $2 . Timer_Op_Id_Value ; 
The_Timer_Op_Record . Timer_Id := $4 . Psdl_Id_Value ; 
The_Timer_Op_Record . Guard := The_Expression_String 

Timer_Op_Set_Pkg .Add ( The_Timer_Op_Record, 

The_Timer_Op_Set ) ; 

Bind_Timer_Op ( The_Operator_Name, 

The__Time r_Op_Set , 

The_Timer_Op) / 



opt_trigger 

: TRIGGERED_TOKEN trigger 

{ 

The_Expression_String := Expression (A_St rings . Empty ) ; 

} 

opt_if_predicate reqmts_trace 

{ 

Bind_Exec_Guard ( The^Operat or_Name, 

The_Expression_St ring, 

The_Exec_Guard) / 

} 



trigger 

: BY_ALL_TOKEN 

{ 

The_Id_Set := Empt y_Id_Set ; 

} 

id_li st 

{ 

The_Trigger_Record . Tt := By_All; 

The_Trigger_Record . Streams := The_Id Set; 
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Bind_Trigger (The_Operator_Name , 
The_Trigger_Record, 
The_T rigger) ; 

} 

I BY_SOME_TOKEN 

{ 

The_Id_Set := Empty_Id_Set ; 

} 



id_list 

{ 



} 



The_Trigge r_Record . Tt := By_Some; 

The_Trigge r_Record . Streams := The_Id_Set 
Bind_Trigger ( The_Operator_Name , 
The_Trigger_Record, 
The_Trigger) ; 



{ 



— we don't care what is in the id set 
The_Trigger_Record . Tt := None; 

The_Trigge r_Record . Streams := The_Id_Set 
Bind_Trigger ( The_Operator_Name , 
The_Trigger_Record, 
The_Trigger) ; 



opt_pe riod 

: PERIOD_TOKEN Time Reqmts_Trace 

{ 

Bind_Timing ( The_Operator_Name , 
$3 . Integer_Value , 
The_Per) ; 

} 



opt_f inish_within 

: FINISH_TOKEN WITHIN_TOKEN time reqmts_trace 

{ 

Bind_Timing (The_Operator_Name, 

$3 . Integer_Value , 
The_Fw) ; 

} 
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opt_mcp 



: MINIMUM_TOKEN CALL_PERIOD_TOKEN time reqmts_trace 

{ 

Bind_Timing (The_Operator _Name, 

$3 . Integer_Value, 

The_Mcp) ; 

} 



Opt_Mrt 

: max_resp_t ime time reqmts^trace 

{ 

Bind_Timing (The__Operat or_Name, 
$3 . I nteger_Value , 
The_Mrt) ; 

} 



max_resp_t ime 

: MAXIMUM TOKEN RESPONSE TOKEN TIME TOKEN 



timer_op 

: RESET_TOKEN 

* { 

$$ := (Token_Category => Timer_Op_Id_String 
Timer_Op_Id_Value => Reset) ; 

} 



I START_TOKEN 

{ 

$$ := (Token_Category => Timer_Op_Id__St ring 

Timer__Op__Id_Value => Start) / 

} 



I STOP_TOKEN 

{ 

$$ := (Token_Category => Timer_Op_Id_String 

Timer_Op_Id_Value => Stop) ; 

} 



opt^if _predicate 

: IF__TOKEN expression 

I 
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-- /* We Add Each Expression In The_Init_Expr_Seq To Preserve The */ 

— /* Order Of Expressions Corresponding Each State. This Sequence */ 

— /■* Is Used By Procedure Bind_Initial_Expression Together With ’^/ 

— /* States Map To Construct The Init_Map. */ 

-- /* Initialization Of The Sequence Is Done Before (By The Parent */ 

— /■* Rule) . 



init ial_expression_list 

: initial_expression_list 

{ 

The_Expression_String := Expression (A_Strings . Empty ) ; 

} 



init ial_expression 

{ 



} 



Init_Exp_Seq_Stack_Pkg .Pop ( The_Init_Exp_Seq_Stack , 

Temp_Init_Expr_Seq) ; 
Exp_Seq_Pkg . Add ( $ 4 . Expression_Value , 
Temp_Init_Expr_Seq) ; 

Init_Exp_Seq_Stack_Pkg . Push (The_Init_Exp_Seq_Stack, 

Temp_Init_Expr_Seq) ; 



{ 

The_Expression_String := Expression (A_Strings . Empty ) ; 

} 



initial_expression 

{ 



} 



Init_Exp_Seq_Stack_Pkg .Pop (The_Init_Exp_Seq_Stack, 

Temp_Init__Expr_Seq) ; 
Exp_Seq_Pkg . Add ($2 . Expression_Value , 
Temp_Init_Expr_Seq) ; 

Init_Exp_Seq_Stack_Pkg . Push (The_Init_Exp_Seq_Stack , 

Temp_Init_Expr_Seq) ; 



-- /* There is one and only one initial state (initial expression) */ 

— /* for each state variable. This production return one */ 

-- /* expression to the parent rule corresponding to one state. */ 

-- /* This is done by using the internal stack ($$ convention) 

— /* the global variable the_expression_st ring also holds the */ 

— /* value of the initial expression, and is needed to get the */ 

— /* string value of the epression resulted by the type_name and * / 

— /* type_decl productions. The_initial_expression_string / 
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-- f variable is initialized in the same way by the parent rule */ 
— /* to empty_expression . 



init ial_expression 
: TRUE 



{ 

$$ 



} 



(Token_Category => Expre ssion_St ring , 
Expression_Value => To_A{ "True")); 



I FALSE 

{ 

$$ := {Token_Category => Expression_String, 

Expre ssion_Value => To_A( "False"))/ 

} 



I INTEGER_LITERAL 

{ 

$$ := {Token_Category => Exp ression_St ring, 

Expre ssion_Value => Expression {The_Integer_Token) ) ; 

} 



I REAL_LITERAL 

{ 

$$ := (Token_Category => Expression_St ring, 

Expression_Value => The_Real_Token) ; 

} 



I STRING_LITERAL 

{ 

$$ := (Token_Category => Expressionist ring, 

Expre ssion_Value => TheiStringiToken) ; 

} 



I IDENTIFIER 

{ 

$$ := (Token_Category =■> Expressionist ring, 

Expression_Value => Expression {TheiId_Token) ) ; 

} 



-- /* We Initialized TheiExpres si oniString To Empty */ 
-- i* At The Parent Rule, So That Type_Name Production */ 
-- /* Will Get TheiExpression_String As An Empty Variable */ 



I type_name IDENTIFIER 

{ 

TheiExpression_String := The_ExpressioniString & "." & 

Expression (TheildiToken) ; 

$$ ;= (TokeniCategory => Expression_String, 

ExpressioniValue => TheiExpressioniString) ; 

} 
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1 type_name 



IDENTIFIER 



{ 



$$ 



} 



(Token_Category ~> Expressionist ring , 
Expression_Value => The_Expression_String & 

& Expression ( The_Id_Token )) ; 



' ( ' 



{ 

Init_Exp_Seq_Stack_Pkg . Push (The_Init_Exp_Seq_Stack, 

Empty_Exp_Seq) ; 



} 



1 



init ial_expression_list ')' 

{ 

— /* we remove expression resulted by the '*^7 
— /* previous rule, since expression will */ 

— i be concat ination of Type_name.ID and */ 

— /* value of previous production */ 

Init_Exp_Seq_StackiPkg . Pop ( The_Init_Exp_Seq_Stack, 

Temp_Init_Expr_Seq) ; 

The_Expression_String := Expression (A_St rings .Empty); 



for i in 1 .. Exp_Seq_Pkg . Length (Temp__Init_Expr_Seq) loop 

if i > 1 then 

The_ExpressioniString := The_Expression_S tring & " 

end if; 

The_Expression_String := 

The_Expression_String & 

Exp_Seq_Pkg . Fetch ( Temp_InitiExpr_Seq, i 

end loop; 

Exp_Seq_Pkg . Recycle ( Temp_InitiExpr_Seq) ; — throw it away 



$$ := (Token_Category => 

Expression^Value => 



} 



Expressionist ring, 

$ 4 . ExpressioniValue & "(" & 

TheiExpressioniSt ring & ")"); 



initialiOxpression ')' 

{ 

$$ := (TokeniCategory => ExpressioniSt ring, 

ExpressioniValue => TOiA("(") & 

$2 . ExpressioUiValue & 

TOiA(") ") ) ; 

} 



init ialiexpression logiOp 

{ 

$$ := (TokeUiCategory => 

ExpressioUiValue => 



} 



E xp re ssioUiS tring, 

$ 1 . ExpressioniValue & 
$2 . ExpressioUiValue ) ; 
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%prec logical_operator 



init iax_expression 

{ 

$$ ;= (Token_Category => Expression_String , 

Expression_Value => $ 3 . Expres sion_Value & 
$ 4 . Expres SI on_Value ) ; 



I init ial_expression rel_op 
init ial_expres sion 



%prec relat ional_operator 



$$ := (Token_Category => Expression_St ring , 

Expression_Value => $ 1 . Expression__Value & 

$2 . Expression_Value & 
$3 . Expres sion_Value ) ; 



I initial_expression %prec unary_adding_operator 

{ 

$$ := ( Token_Category => Expression_St ring, 

Expression_Value => To_A("-") & $2 . Expression_Value ) ; 

} 



I init ial_expression 



%prec unary_adding_operator 



{ 



$$ := (Token_Category => Expression_String, 

Expression_Value => To_A ("+'') & $ 2 . Expres si on Value); 



I init ial_expression bin_add_op 



init ial_expres sion 



%prec multiplying_operat or 



$$ := (Token_Category => Expression_String , 

Express ion_Value => $ 1 . Expression_Value & 

$2 . Expression_Value & 
$3 . Expression_Value) ; 



I initial_expression bin_mul_op 



init ial_expression 



%prec mult iplying_operator 



$$ := (Token_Category => Expression^String, 

Expression_Value => $ 1 . Expression_Value & 

$2 . Expression_Value & 
$3 . Expression Value); 
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1 init ial_expression EXP_TOKEN 



in it ial_expression 



%prec highest_precedence_operator 



{ 



$$ := (Token_Category => Expression_St ring , 

Expression_Value => $ 1 . Expression_Value & 
To_A(" EXP ") & 

$3 . Expression_Value ) ; 



I NOT TOKEN 



init ial_expres s ion 



%prec highest_precedence_operator 



{ 



} 



— Exp_Seq_Pkg . Add ( The_Expression_String, The_Exp_Seq) ; 
$$ := (Token_Category => Expression_String , 

Expression_Value => To_A(" NOT ") & 

$2 . Expression_Value ) ; 



I ABS_TOKEN 

init ial_expression 



%prec highest_precedence_operat or 



$$ := (Token_Category ==> Expression_String, 

Expression_Value => To_A(" NOT ") & 

$ 2 . Expression_Value ) ; 



log_op 



: AND_TOKEN 

{ 

$$ 

} 

I OR_TOKEN 

{ 



$$ : = 



(Token_Category => Expression_String, 
Expression_Value => To_A(" AND ") ) ; 



(Token_Category => Expression_St ring, 
Expression_Value => To_A(" OR ") ) ; 



} 



I XOR_TOKEN 
{ 

$$ 

} 



(Token_Category => Expression_St ring, 
Expression_Value => To A(" XOR ”) ) ; 



KX) 



rel_op 



{ 

$$ (Token_Category => Exp ression_St ring 

Expression_Value => To__A(" < ") ) ; 

} 

I '>' 

{ 

$$ := (Token__Category => Expression_St ring 

Expression_Value => To_A(" > ") ) ; 

} 



{ 

$$ := (Token_Category => Exp ression_St ring 
Expression_Value => To_A(" = ") ) ; 

} 



I GREATER_THAN_OR_EQUAL 

{ 

$$ ;= (Token_Category => Expressionist ring 

Expression_Value => To_A(" >= ") ) ; 

) 



I LESS_THAN_OR_EQUAL 

{ 

$$ := (Token_Category => Expression_St ring 

Expression_Value => To_A(" <= ") ) ; 

} 



1 INEQUALITY 

{ 

$$ := (Token_Category -> Expression_St ring 

Expression__Value => To_A(" /= ")); 

} 



bin_add op 

{ 

$$ 

} 



:= (Token_Category => Express ion_St ring 
Expression_Value => To_A(" - ") ) ; 



{ 

$$ 

} 



:= (Token_Category => Expression_St ring 
Expression_Value => To_A(" + ") ) ; 
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{ 






$$ 



} 



(Token_Category => Expression_String, 
Expression_Value -=> To_A(" & ") ) ; 



bin_mul_op 

. \ * f 

{ 

$$ := (Token_Category => Expressionist ring, 

Expression_Value => To_A(" + ") ) ; 

} 

i V' 



$$ 



} 



(Token_Category => Expression^String, 
Expression_Value => To_A(" - ") ) ; 



I MOD_TOKEN 

{ 

$$ := (Token_Category => Expression_St ring, 

Expression_Value => To_A(" MOD ") ) ; 

} 



I REM_TOKEN 

{ 

$$ := (Token_Category => Expression_St ring, 

ExpressioniValue => To_A(" REM ") ) ; 

} 



time 



time_number MICROSEC_TOKEN 

{ $$ ;= ( Token_Category 

Integer_Value 
The_Time_String := 

To_A ( Integer ' Image ($ 1 . Integer_Value) & " microsec 

} 



=> Integer_Literal , 

=> ($1 . Integer^Value + 999)/1000) 



I time_number MS_TOKEN 

{ 

$$ := (Token_Category => Integer_Literal , 

Integer_Value => $ 1 . Integer_Value) ; 
The_Time_String := 

To_A ( Integer' Image ( $1 . Integer_Value) & " ms") ; 

} 

I time number SEC TOKEN 
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$$ := (Token_Category => Integer_Liter al , 

Integer_Value •=> $ 1 . Intege r_Value * 1000;; 

The_Time_String := 

To_A { Integer ' Image ($ 1 . Intege revalue) & " sec''); 



t time_number MIN_TOKEN 

{ 

$$ := (Token_Category => Integer_Lit eral , 

Integer_Value => $ 1 . Integer_Value ^ 60000); 
The_Time_String ;= 

To_A ( Integer ' Image ($ 1 . Intege r_Value) & " min"); 



I time_number HOURS_TOKEN 

{ 

$$ := {Token__Category => Integer_Literal , 

Integer_Value => $ 1 . Intege r_Value * 3600000); 
The_Time_String := 

To_A (Integer' Image ($1 . Integer_Value) & " hrs"); 



time_number 

: INTEGER_LITERAL 

{ 

$$ := (Token_Category => Intege r_Literal , 

Integer_Value => Convert_To_Digit (The_Int eger_Token . S ) ) 

} 



— /* Initialization of The_Expression_St ring should * / 
should be done by the parent rules * / 

expression_list 

: expres sion_l ist 

{ 

The_Time_String := Expre ss ion (A_St rings . Empty ) ; 

} 

expression 

I 



The_Time_St ring := Expression (A_St rings . Empty ) ; 

} 

expression 
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-- / ■* Expressions Can Appear In Guards Appearing In Control Constraints. */ 

— /* These Guards Can Be Associated With Triggering Conditions, Or * / 

— /* Conditional Outputs, Conditional Exceptions, Or Conditional Timer */ 

— /* Operations. Similar To Initial Expression, Except That Time Values */ 

— /* and References To Timers And Data Streams Are Allowed. */ 



expression 

: TRUE 

{ 

The_Expression_String := The_Expression_St ring & " TRUE 

} 

I FALSE 

{ 

The__Expression_String := The_Expression_St ring & ” FALSE " 

} 



I INTEGER_LITERAL 

{ 

The_Expression_String 



} 



The_Expression_String & " " & 
Expression (The_Integer_Token) ; 



I time 



The_Expression_String 



} 



The_Expression_String & " " & 
The_Time_String; 



REAL_LITERAL 

{ 



The_Expression_String 

} 



The_Expression_St ring & " " & 
T he_Re a 1_T oke n ; 



I STRING_LITERAL 

{ 

The_Expression_String 



} 



The_Expression_String & " " & 
The_String_Token; 



I 



IDENTIFIER 



{ 

The_Expression_String 

} 



The_Expression_St ring & " " & 
Expression (The__Id_Token ) ; 



I type_name IDENTIFIER 

{ 
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6 



The_Expression_String 



} 



The_Expression_St ring & " 
Expression (The_Id_Token ) ; 



I type_name IDENTIFIER 



The_Expression_St ring 

) 



The_Expression_St ring & & 

Expression ( The_Id_Token ) ; 



{ The_Expres sion_String := The_Expression_St ring & " {"/ } 

expression_list ')' 

{ 

The_Expression_St ring := The_Expression__St ring & ") 
Exp_Seq_Pkg . Add ( The_Expression_St ring, The_Exp_Seq) ; 



I ' ( ' 

{ The_Expression_String := The_Express ion_St ring & " ("; } 

expression ' ) ' 

{ The_Expression_Str ing := The_Expression_St ring & ") ) 

I expression log_op 

{ 

The_Expression_String := 

The_Expression_St ring & $2 . Expression_Value; 

} 

expression %prec logical_operator 



i expression rel_op 

{ 

The_Expression_St ring := 

The_Expression_String & $2 . Expression__Value; 

) 

expression %prec relat ional^operat or 



{ The_Expression_String := The_Expression_St ring & } 

expression %prec unary_adding_operator 



{ The__Expression_String := The_Expression_St ring & } 

expression %prec unary_adding_operator 

I expression bin_add_op 

{ 



lOS 



} 



The_Expres sion_String 

The_Expression_Str.ing & $2 . Expression_Value; 



expression %prec binary_adding_operat or 

I expression bin_mul_op 

{ 

The_Expression_String := 

The_Expression_String & $2 . Expression_Value; 

} 



expres sion 



%prec multiplying_operator 



I expression EXP_TOKEN 

{ 

The_Expression_String := 

The_^Expression_String & " EXP } 

expression %prec highest__precedence_operator 



I NOT_TOKEN 

{ The_Expression_String 
expression 
I ABS_TOKEN 

{ The_Expression_String 
expression 



To_A(" NOT "); } 

%prec highest_precedence_operat or 
To_A(" ABS ") ; } 

%prec highest_precedence_operator 



%% 

-- $source: /n/gemini/work/bayram/AYACC/parser/RCS/psdl . y , v $ 



10 () 



— $date: 1991/08/28 10:04:49 $ 



Package Spec PARSER 



with Text_Io, Psdl_Component_Pkg, Psdl_Concrete_Type_Pkg, Stack_Pkg, 
Psdl_Graph_Pkg, Generic_Sequence_Pkg, A_Strings; 
use Psdl_Component_Pkg, P sdl_Concrete_Type_Pkg, Psdl_Graph_Pkg; 

package Parser is 

— Global Variable Which Is A Map From P sdl_Component Names To Psdl 
-- Component Definitions 

The_Program -- Implemented 

: Psdl_P rogram ; 



— Global Variable For A Psdl_Component (Type Or Operator) 

The_Component — Implemented 

: Psdl^Component ; 



— Global Variable Which Points To The P sdl_Component (Type Or Operator) 

The_Component_Pt r — Implemented 

: Component_Ptr; 



— Global Variable Which Points To The Psdl Operator (Type Or Operator) 

The_Op_Ptr — Implemented 

: Op_Ptr; 

— used to construct the operation map 
The_Operator : Operator; 



— Global Variable For An Atomic Type — Implemented 

The_Atomic_Type 
: Atomic_Type; 

-- Global Variable For An Atomic Operator 



The_Atomic_Operator 
: Atomic_Operator; 

— Global Variable 

The_^Composite_Type 
: Composite_Type ; 



For A Composite Psdl 



— Implemented 

Type 

-- Implemented 
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— Global Variable For A Composite Psdl Type 



The_Composite_Operat or — Implemented 

: Composite_Operator ; 

— /* Global Variables For All Psdl Components: */ 



— Global Variable Which 


Holds The Name Of The Component 


The_Psdl Name 
: Psdl_Id; 


— Implemented 


— Global Variable Which 


Holds The Ada_Id Variable Of Component Record 


The Ada Name 
: Ada_Id; 


— Implemented 


— Global Variable Which 


Holds The Generic Parameters 


The Gen Par 

; Type Declaration; 


— Implemented 


— used for psdl type part 


(for not to mix with operation map) 



The_Type_Gen_Par : Type_Declaration; 



— Global Variable Which 


Holds The Keywords 


The Keywords 
: Id Set; 


— Implemented 


The_De script ion 
: Text; 


— Implemented 


The Axioms 
: Text; 


— Implemented 



— A Temporary Variable To Hold Output_Id To Construct Out_Guard Map 

The_Output_Id 
: Output_Id; 

— A Temporary Variable To Hold Excep_Id To Construct Excep_Trigger Map 



The_Excep_Id 
: Excep Id; 




— Global Variables For 


All Psdl Types: 


— Used For Creating All 


Types 


The_Model 

: Type_Declaration ; 


— Implemented 
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Implemented 



The_Operation_Map 
: Operat ion_Map/ 



— Used For Creating Composite Types 

The_Data_St ructure -- Implemented 

: Type_Name; 



-- Global Variables For All Operators: 



The Input 

: Type Declaration; 




Implemented 


The_Output 

: Type Declaration; 


— 


Implemented 


The State 

: Type_Declaration; 


-- 


Implemented 


The Initial Expression 
; Init Map; 


— 


Implemented 


The Exceptions 
: Id_Set; 


-- 


Implemented 


The_Specif ied_Met 
: Millisec; 

— Global Variables For Composite Operators: 




Implemented 


The_Graph 

: Psdl Graph; 


-- 


Implemented 


The Streams 

: Type Declaration; 


— 


Implemented 


The Timers 
: Id_Set; 


— 


Implemented 


The_Trigger 

: Trigger_Map; 


-- 


Implemented 


The_Exec Guard 

: Exec Guard Map; 


— 


Implemented 


The Out Guard 

: Out Guard Map; 


— 


Implemented 


The Excep Trigger 

: Excep_Trigger_Map; 


— 


Implemented 


The Timer Op 


— 


Implemented 
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: Timer_Op_Map; 



The_Per 

: Timing^Map; 



Implemented 



The_Fw 

: Timing_Map; 



— Implemented 



The_Mcp 

: Timing_Map; 



— Implemented 



The Mrt 



— Implemented 



: Timing_Map; 



The_Impl_Desc 

: Text := Empty_Text; 

— Is Used For Storing The Operator Names In Control Constraints Part 

The_Operat or_Name 
: Psdl_Id; 



— A Place Holder To For Time Values 

The_Time 

: Millisec/ 

— True If The P sdl^Component Is An Atomic One 

Is_Atomic_Type — Implemented 

: Boolean; 

Is_Atomic_Operat or : Boolean; 

— Holds The Name Of The Edge (I.E Stream Name) 

The_Edge_Name — Implemented 

: Psdl^Id; 



-- Renames The Procedure Bind In Generic Map Package 

— Psdl Program Is A Mapping From Psdl Component Names . . 

— . . To Psdl Component Definitions 

Procedure Bind_Program 
( Name ; In Psdl^Id; 

Component : In Component_Ptr ; 

Program : In Out 
Psdl_Program ) 

Renames Bind; 



no 



-- Renames The Procedure Bind In Generic Map Package 
— Psdl Program Is A Mapping From Psdl Id'S To Psdl Type Names 

Procedure Bind_Type_Decl_Map 
( Key : In Psdl_Id; 

Result : In Type_Name; 

Map : In Out 

Type_Declarati on ) 

Renames Type_Declaration__Pkg . 

Bind ; 



— Renames The Procedure Bind In Generic Map Package 

— Operation Map Is A Mapping From Psdl Operator Names To Psdl . 

-- .. Operator Definitions. 

Procedure Bind_Ope rat ion 
( Key : In Psdl_Id; 

Result ; In Op_Ptr; 

Map : In Out Operation_Map ) 

Renames Bind; 



-- Renames The Procedure Bind In Generic Map Package 

— Trigger Map Is A Mapping From Psdl Operator Names To Trigger 

— . . Types (By Some, By All, None . . 

Procedure Bind_Trigger 
( Key : In Psdl_Id; 

Result : In Tr igger_Record; 

Map : In Out Trigger_Map ) 

Renames Trigger_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Timing Map Is A Mapping From Psdl Operator Names To 

— . . Some Timing Parameters (Per, Mrt, Fw, Mcp, .. .) 

Procedure Bind_Timing 
( Key : In Psdl_Id; 

Result : In Millisec; 

Map : In Out Timing__Map ) 

Renames Timi ng_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Out_Guard Map Is A Mapping From Output Stream Id' S To 

— . . Expression Strings 



Procedure Bind_Out_Gua rd 
( Key : In Output_Id; 

Result : In Expression; 

Map : In Out Out_Guard_Map ) 

Renames Out_Guard_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Init_Map Is A Mapping From Psdl Id's To .. 

— . . Expression Strings 

Procedure Bind_I nit_Map 
( Key : In Psdl_Id; 

Result : In Expression; 

Map : In Out Init_Map ) 

Renames Init_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Timer_Op_Map Is A Mapping From Psdl Id'S To .. 

— . . Timer_Op_Set 

Procedure Bind_Timer_Op 
( Key : In Psdl_Id; 

Result : In Timer_Op_Set ; 

Map : In Out Timer_Op_Map ) 

Renames Time r_Op_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Exception Trigger Map Is A Mapping From Psdl Id'S To .. 

— . . Expression Strings 

Procedure Bind_Excep_Trigger 
( Key : In Excep_Id; 

Result : In Expression; 

Map : In Out 

Excep_Trigger_Map ) 

Renames Excep__Tr igger__Map__Pkg . 

Bind ; 



— Renames The Procedure Bind In Generic Map Package 

— Exec_Guard Map Is A Mapping From Psdl Id'S To .. 
-- . . Expression Strings 

Procedure Bind Exec Guard 
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( Key ; In Psdl_Id; 

Result : In Expression; 

Map ; In Out Exec_Guard__Map 

) 

Renames Exec__Gua rd_Map_Pkg .Bind; 



— Implements A Temporary Storage For Type Declaration. 

Package Type_Decl_St ack_Pkg Is 

New Stack_Pkg (Type_Declarat ion) 



Use Type_Decl_Stack_Pkg; 

Subtype Type_Decl_St ack Is 
Type_Decl_St ack_Pkg .Stack ; 

— A Stack Declaration And Initialization For Type_Declarati on 

The_Type_Decl_St ack 
: Type_Decl_St ack := 

Type_Decl_St ack_Pkg . Create ; 



Package Id_Set_Stack_Pkg Is 
New Stack_Pkg (Id_Set) ; 

Subtype Id_Set_Stack Is 
Id_Set_Stack_Pkg .Stack ; 

— A Stack Declaration And Initialization For Id 

The_Id_Set_Stack 
: Id_Set_Stack := 

Id_Set_Stack_Pkg .Create; 

— Global Declaration For Type_Id_Set 

The_Id_Set — Implemented 

: Id_Set; 



The_Id_Set_Size 
: Natural; 



Package Express! on_Stack_Pkg Is 
New Stack_Pkg (Expression) ; 

Subtype Expression_Stack Is 
Expression_Stack_Pkg .Stack ; 
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A Stack Declaration And Initialization For Id 



The_Expression_Stack 
: Expres sion_Stack := 

Expres sion_Stack_Pkg .Create; 



Package Exp_Seq_Pkg Is 

New Generic_Sequence_Pkg (T => 

Expression, Block_Size => 24 

) ; 

Subtype Exp_Seq Is 

Exp_Seq_Pkg. Sequence; 

-- returns an empty expression sequence 
function Empty_Exp_Seq return Exp__Seq; 

The_Exp_Seq 
: Exp_Seq; 



The_Init_Expr_Seq ; Exp_Seq; -- Used For Constructing Init_Map 
Temp_I ni t_Expr_Seq : Exp_Seq; 

package Init_Exp_Seq_Stack_Pkg is 
new Stack_Pkg (Exp_Seq) ; 

subtype Init_Exp_Seq_Stack is Init_Exp_Seq_Stack_Pkg . Stack; 
The_Init__^Exp_Seq_Stack : 

Init_Exp_Seq_Stack := Init_Exp_Seq_Stack_Pkg .Create; 



Procedure Remove_Expr_From_Seq Is 

New Exp_Seq_Pkg . Generic_Remove (Eq => "="); 



Package Id__Seq_Pkg Is 

New Generic_Sequence_Pkg (T => Psdl^Id, 

Block_Size => 24); 



Subtype Id_Seq Is 

Id_Seq_Pkg . Sequence; 

The_Id_Seq 
: Id_Seq; 



The_Init_Map_Id_Seq ; Id_Seq; — to hold the id's to construct init map 

— these are the same id's used in state map. 



— Holds The Name Of The Types; 
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The_Type_Name 
: Type_Name; 



— Used For The Type Decl Part Of Type_Name 
The_Type_Name_Decl : Type_Declaration; 



-- A Temporary Type_Decl 
Temp_Type_Decl 

: Type_Declaration ; 

— A Temporary Variable For Holding The Identifiers 

The_St ring 
: Psdl_Id; 

-- A Temporary Variable For Trigger^Record 

The_Trigger_Record 
: Trigger_Record; 

— A Temp Variable For Holding The Value Of Timer_Op 

The_Timer_Op_Record 
: Timer_Op; 

The_Timer_Op_Set 
: Timer_Op_Set ; 

-- A Temp Variable For Producing The Expression String 

The_Expressi on_String 

: Expression := Expression ( 

A_Stri ngs . Empty ) ; 

-- A Temp Variable For Producing The Time String 

The_Time_String 

: Expression := Expression ( 

A_St rings . Empty ) ; 



Echo 



: Boolean := False; 

Number_Of_Errors 
: Natural := 0; 

Semant ic_Error : Exception; 



Procedure Yyparse; 



procedure GET {Item : out PSDL_PROGRAM) ; 
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procedure GET ( Input_File_N 
Output_File_N 
Item 



in String; 

in String := 

out PSDL_PROGRAM) ; 



end Parser; 



Package body PARSER 



with Psdl_Tokens, Psdl^Goto, 

Psdl_Shif t_Reduce, Psdl_Lex, 
Text_Io, P sdl_Lex_Df a, 
Psdl_Lex_Io, A_Strings, 
Psdl_Concrete_Type_Pkg, 
Psdl_Graph_Pkg, 
Generic_Sequence_Pkg; 

use Psdl_Tokens, Psdl_Goto, 

Psdl_Shi ft_Reduce, Psdl_Lex, 
Text_I o, 

Psdl_Concrete_Type_Pkg, 

Psdl_Graph_Pkg; 



package Body Parser is 

— this flag is set to true when optional_generic_param 

— rule is parsed, to overcome the problem when two 

— id's come after one another. See psdl_lex.l file 

Type_Spec_Gen_Par : Boolean := FALSE; 



— function Empty_Exp_Seq 



function Empty_Exp_Seq return Exp_Seq is 
S: Exp_Seq; 
begin 

Exp_Seq_Pkg . Empty ( S) ; 
return S; 

end Empty_Exp_Seq; 



— Procedure Yyerror 



procedure Yyerror 
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( S : In String := 

"Syntax Error" ) is 
Space 

: Integer; 

begin — Yyerror 

Number_Of _Errors := 

Nuinber_Of_Errors t 1; 
Text_Io . New_Line; 

Textile . Put ( "Line" & Integer' 
Image (Lines - 1) & ") ; 

Text_Io . Put_Line (Psdl_Lex_Df a . 
Yytext ) / 

Space := Integer (Psdl_Lex_Df a . 
Yytext ' Length) + Integer' 
Image ( Line s) ' Length + 5; 
for I In 1 . . Space loop 

Put ("-") ; 
end loop; 

Put_Line("^ " & S) ; 
end Yyerror; 



-- function Convert_To_Digit 

— Given A String Of Characters Corresponding To A Natural Number, 

— Returns The Natural Value 



function Convert__To_Digit 
( St ring__Digit : String ) 
Return Integer Is 
Multiplier 

: Integer := 1; 

Digit, Nat_Value 
: Integer := 0; 

Begin — Convert_To_Digit 
For I In Reverse 1 . . 

St ring_Digit ' Length Loop 
Case String_Digit ( I ) Is 



When '0' 


= > 


Digit 


:= 0; 


When '1' 


= > 


Digit 


:= 1; 


When '2' 


= > 


Digit 


:= 2; 


When '3' 


= > 


Digit 


:= 3; 


When M' 


= > 


Digit 


:= 4; 


When '5' 


= > 


Digit 


:= 5; 


When '6' 


= > 
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Digit := 6; 

When '7' => 

Digit := 7; 

When '8' => 

Digit := 8; 

When '9' => 

Digit := 9; 

When Others => 

Null; 

End Case; 

Nat_Value := Nat^Value + ( 

Multiplier * Digit); 
Multiplier := Multiplier * 10; 
End Loop; 

Return Nat_Value; 
end Convert_To_Digit ; 



— procedure GET 

— Reads the psdl source file^ parses it and creates the PSDL ADT 

— Input file is line numbered and saved into a file 

— input file name .1st in the current directory. So if 

— there is no write permission for that directory, exception 

— Use_Error is raised and program aborts, if the second argument 

— is passed psdl file resulted form PSDL ADT is written into a 

— file with that name. 



procedure GET ( Input_File_N : in String; 

Output_File_N : in String := 

Item : out PSDL_PROGRAM ) is 



begin 

Psdl_Lex_I o . Open_Input ( I nput_File_N) ; 
if Output_File_N /= "" then 

Psdl_Lex_Io . Great e_Output (Output_File_N) ; 
else 

Psdl_Lex_Io . Create_Output ; 
end if; 

Text_Io . Create (Psdl_Lex . List_File, Out_File, Input_File__N & ".1st") 
Psdl^Lex . Linenum; 

YYParse; 

Psdl_Lex_I o . Close_Input ; 

Psdl_Lex_I o . Close_Output ; 

Item := The_Program; 

Text_Io .Close (Psdl_Lex . List_File) ; 

end Get; 
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— procedure GET — 

Reads the standard input, parses it and creates the 

— PSDL ADT . Input file is line numbered and saved into a 

-- file input file name ,1st in the current directory. So if -- 

-- there is no write permission for that directory, exception -- 
-- Use^Error is raised and program aborts. -- 



procedure GET {Item : out PSDL_PROGRAM) is 
begin 

Text_Io . Create (Psdl_Lex . List_File, Out_F ile, "stdin . psdl .1st") ; 
Psdl_Lex . Linen urn ; 

YYParse; 

Psdl_Lex_I o . Close_Input / 

Psdl_Lex_Io , Close_Output / 

Item := The_Program; 

Text^^Io .Close ( Psdl_Lex . List_File ) ; 
end Get; 



— procedure Bind_Type_Declaration 

— /^ Bind Each Id In Id The Id */ 

--/* Set To The Type Name ^ / 

Return Temp__Type_Decl */ 



Procedure Bind_Type_Decl aration ( I_S : In Id_Set; 

Tn : In Type_Name; 

Td : in out Type_Declaration ) is 



begin 
— /* 


m4 code 




— 


foreach([Id; Psdl Id], 


[ Id_Set_Pkg . Generic 


— /* 






— /* 


[ 






Bind Type Decl 


_Map(Id, Tn, Td) ; 


—r 


]) 




— /* 


Begin expansion of FOREACH loop macro. 



declare 

procedure Loop_Body ( Id : Psdl_Id) is 
begin 

Bind_Type_Decl_Map ( Id, Tn, Td) ; 
end Loop_Body; 
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procedure Execute_Loop is 

new Id_Set_Pkg . Generic_Scan (Loop_Body) ; 

begin 

execute_loop (I_s) ; 
end; 

— /"*■ end of expansion of FOREACH loop macro, 
end Bind_Type_Declarat ion ; 



— procedure Bind_Initial_State 

— /'*' Bind Each Id In the State map domain 

— /* Set To The Type Name initial expression 



procedure Bind_Initial_State ( State : in Type_Declarat ion; 

Init_Seq : in Exp_Seq; 

Init_Exp_Map : out Init_Map) is 

i : Natural := 1; 



— /+ m 4 macro code for binding each initial expression in __/★ 

--/* the_init_expr_seq to the id's in state declaration map — /* 

— /* foreach([Id: in Psdl_Id; Tn: in Type_Name] , — /* 

— /* [ Type_Declaration_Pkg . Generic_Scan] , — /* 

— /* [State], — /* 

[ — /* 

— /* Bind_Init_Map (Id, Exp_Seq_Pkg . Fetch (The_Init_Exp_Seq, i) , — /* 

— /* The_Initial_Expression) 

— /* i := i t 1; — /* 

— /* ]) — /* 



begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure Loop_Body ( Id : in Psdl_Id; Tn : in Type_Name) is 

begin 

if i > Exp_Seq_Pkg . Length (The_Init_Expr_Seq) then 

Yyerror ( "SEMANTIC ERROR - Some states are not initialized."); 
Raise SEMANTIC_ERROR; 
else 

Bind_Init_Map ( Id, Exp_Seq_Pkg . Fetch ( The_Init_Expr_Seq, i), 
The_Initial_Expression ) ; 

i : = i + 1 ; 
end if; 

end Loop_Body; 

procedure execute_loop is new Type_Declaration_Pkg . Generic_Scan (Loop_Body ) ; 
begin 

execute_loop (State) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

-- so you must write [ [x] ] in the m4 source file 
— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case spellings of 
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and "DNL 



— the identifier names "DEFINE", "UNDEFINE", 

-- or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- may not work correctly if FOREACH loops are nested. 

-- An expression returned from within a loop body must not 
-- mention any index variables of the loop. 

-- End expansion of FOREACH loop macro. 

-- if number if initial states > number of states, raise exception 
-- and abort parsing 

if (i-1) < Exp_Seq_Pkg . Length (The_Init_Expr_Seq ) then 

Yyerror ( "SEtlANTIC ERROR - There are more initializations than the states 
raise SEriANTIC_ERROR; 
end if; 

end Bind_I ni tial_State ; 



procedure Make_PSdl_Type 
construct the PSDL TYPE using global variables 



procedure Build_PSdl_Type 



[C Name : 


in 


Psdl Id; 


C a Name : 


in 


Ada Id; 


Mdl : 


in 


Type_Declaration; 


D_Str 


in 


Type Name; 


Ops 


in 


Operation Map; 


G_Par 


in 


out Type Declaration; 


Kwr : 


in 


out Id Set; 


I Desc 


in 


out Text; 


F Desc : 


in 


out Text; 


Is Atomic: 


in 


Boolean; 


The Type ; 


in 


out Data Type) is 



begin 

if IS_ATOMIC then 

The_Type := Make_Atomic_Type 

( Psdl_Name => C_Name, 
Ada_Name => C_A_Name, 
Model => Mdl, 

Gen_Par => G_Par, 
Operations=> Ops, 
Keywords => Kwr, 

Inf ormal^De script ion 
=> I_Desc, 

Axioms => F_Desc ) ; 



el se 

The_Type := Make_Composite_Type 

( Name => C Name, 
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end if; 



Model => Mdl, 

Data_Structure 

=> D_Str, 
Operations=> Ops, 
Gen_Par => G_Par, 

Keywords => Kwr, 

Inf ormal_De script ion 
=> I_Desc, 

Axioms => F_Desc ) ; 



— j* After constructing the component * j 

— /* initialized the global varibales for */ 

— /* optional attributes 



G_Par 
Kwr 
I_Desc 
F Desc 



= Empty_Type_Declaration; 
= Empty_Id_Set ; 

= EMpty^Text; 

= EMpty_Text; 



end Bu ild_PSdl_Type ; 



— procedure Build_PSdl_Operator 

construct the PSDL OPERATOR using global variables 



procedure Build_PSdl_Operator 



C Name : 


in 


Psdl_Id; 


C a Name : 


in 


Ada_ 


_Id; 


G_Par ; 


in 


out 


Type Declaration; 


Kwr ; 


in 


out 


Id_Set; 


I Desc : 


in 


out 


Text ; 


F_Desc 


in 


out 


Text ; 


Inp : 


in 


out 


Type Declaration; 


Otp : 


in 


out 


Type Declaration; 


St : 


in 


out 


Type Declaration; 


I Exp Map: 


in 


out 


Init Map; 


Excps : 


in 


out 


Id Set; 


S_MET : 


in 


out 


Millisec; 


Gr : 


in 


out 


Psdl_Graph ; 


D Stream : 


in 


out 


Type Declaration; 


Tmrs : 


in 


out 


Id Set; 


Trigs 


in 


out 


Trigger Map; 


E Guard : 


in 


out 


Exec Guard Map; 


0_Guard : 


in 


out 


Out Guard Map; 


E_Trigger : 


in 


out 


Excep Trigger Map 


T_Op : 


in 


out 


Timer Op Map; 


Per : 


in 


out 


Timing_Map; 


Fw : 


in 


out 


Timing Map; 


Mcp : 


in 


out 


Timing Map; 


Mrt : 


in 


out 


Timing Map; 
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Im^Desc : in out Text; 

IS_ATOMIC: in Boolean; 

The_Opr : in out Operator) is 



begin 



if IS_ATOMIC then 

The_Opr := Make_Atomic_Operat or 

( Psdl Name => 



Ada_Name => 

Gen_Par => 

Keywords => 

Inf orm a l_De script ion 
=> I Desc, 



C_Name , 
C_A_Name , 
G_P a r , 

Kwr , 



Axioms => F_Desc, 

Input => Inp, 

Output => Otp, 

State => St, 

Initialization_Map 

=> I_Exp_Map, 
Exceptions => Excps, 
Specif ied_Met => S_MET) ; 

else 

The_Opr := Make_Composite_Operat or 

( Name => C_Name, 

Gen_Par => G_Par, 
Keywords => Kwr, 

Inf ormal_De script ion 
=> I Desc, 



Axioms 

Input 

Output 

State 



= > 
= > 
= > 
= > 



F_Desc, 

Inp, 

Otp, 

St, 



Initializat ion_Map 

=> I_Exp_Map, 
Exceptions => Excps, 
Specif ied^Met => S_Met, 



Graph 
Streams 
Timers 
Trigger 
Exec_Guard=> 
Out Guard => 



= > 
= > 
= > 
= > 



Gr, 

D_St ream, 
Tmrs, 
Trigs, 
E_Guard, 

0 Guard, 



Excep_Trigger => E_Trigger, 
Timer_Op => T_Op, 

Per => Per, 

Fw => Fw, 

Mcp => Mcp, 

Mrt => Mrt, 

Impl_Desc => Im_Desc) ; 



end if; 



— /* After constructing the component / 

— /* initialized the global varibales for 

— /* optional attributes ^ / 
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G_Par 


= Empty_Type_Declaration; 


Kwr 


= Empty_Id_Set ; 


I Desc 


= EMpty Text; 


F Desc 


= EMpty_Text; 


Inp 


= Empty Type Declaration; 


Otp 


= Empty Type Declaration; 


St 


= Empty Type Declaration; 


I Exp Map 


= Empty Init Map; 


Excps 


= Empty Id Set; 


S_Met 


= 0; 


Gr 


= Empty Psdl Graph; 


D_St ream 


= Empty Type Declaration; 


Tmrs 


= Empty_Id_Set ; 


Trigs 


= Empty_Trigger_Map; 


E Guard 


= Empty Exec Guard_Map; 


0 Guard 


= Empty Out Guard Map; 


E^Trigger 


= Empty_Excep_Trigger_Map 


T_Op 


= Empty Timer Op Map; 


Per 


= Empty Timing Map; 


Fw 


= Empty_Timing_Map; 


Mcp 


= Empty Timing Map; 


Mrt 


= Empty Timing Map; 


Im Desc 


= EMpty Text; 



end Build__Psdl_Operator; 



procedure Add_Op_Impl_To_Op_Map — 

Uses the operation map we cunstructed only with the — 

specification part. — 

Fetchs the operator from the map, uses to create a new one-- 
with it (specification part) and add the implementation 
to it . 

Remove the old one, and add the new complete operator the — 
map . -- 



procedure 



Add_Op_Impl^T 



(Op Name 


: in 


Psdl_Id; 


A Name 


: in 


Ada_ 


_Id; 


Is_Atomic : 


: in 


Boolean ; 


0 Map 


: in 


out 


Operation Map; 


Gr 


: in 


out 


Psdl Graph; 


D_Stream 


: in 


out 


Type_Declarat ion; 


Tmrs 


: in 


out 


Id_Set; 


Trigs 


: in 


out 


Trigger_Map ; 


E Guard 


: in 


out 


Exec Guard Map; 


0_Guard 


: in 


out 


Out Guard Map; 


E Trigger : 


: in 


out 


Excep__Trigger_Map 


T_0p : 


: in 


out 


Timer Op Map; 


Per 


: in 


out 


Timing Map; 


Fw 


: in 


out 


Timing Map; 
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Mcp 


: in 


Mrt 


: in 


Im Desc 


: in 



out Timing_Map; 
out Timing_Map; 
out Text ) IS 



Temp_Op : Operator; 

Temp_Op_Ptr : Op_Ptr; 

begin 

if Operation_Map_Pkg . Member (Op_Name , Operation_Map_Pkg . Map (0_Map) ) then 
Temp_Op := Operat ion_Map_Pkg . Fetch (Operation_Map_Pkg . Map (0_Map) , 
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Op_Name ) . all ; 

Operation_Map_Pkg . Remove (Op_Name, Operation_Map_Pkg . Map (0_Map) ) ; 
if Is_Atomic then 

Temp_Op ;= Make_Atomic_Operator 

(Psdl_Name => Op_Name, 

Ada_Name => A_Name, 

Gen_Par => Gener ic_Parameters ( Temp_Op) , 

Keywords => Keywords (Temp_Op) , 

Inf ormal_De script ion 

=> Inf ormal_Description (Temp _0p) , 

Axioms => Axioms (Temp_Op) , 

Input => Inputs (Temp_Op) , 

Output => Outputs (Temp_Op) , 

State => States { Temp_Op) , 

Init iali zation_Map 

=> Get_Init_Map (Temp_Op) , 

Exceptions=> Exceptions (Temp_Op) , 

Specif ied_Met => 

Specif ied_Maximum_Execution_Time (Temp_Op) ) / 



Temp_Op_Ptr := new Operator (Category => Psdl_Operator, 

Granularity => Atomic) ; 
Temp_Op_Ptr . all := Temp_Op; 



else 

Temp_Op 



:= Make_Composite_Operator 

(Name => Op_Name, 

Gen_Par => Generic_Parameters (Temp_Op ) , 
Keywords => Keywords ( Temp_Op) , 

Inf ormal_Description 

=> Inf ormal_Description (Temp_Op ) , 
Axioms => Axioms ( Temp_Op) , 

Input => Inputs (Temp _0p) , 

Output => Outputs (Temp_Op) , 

State => States (Temp_Op ) , 

Initialization_Map 

=> Get_Init_Map (Temp_Op ) , 

Exceptions=> Exceptions (Temp_Op) , 

Specif ied_Met => 

Specif ied_Maximum_Execution__Time (Temp_Op) , 
Graph => Gr, 

Streams => D^Stream, 

Timers => Tmrs, 

Trigger => Trigs, 

Exec Guard=> E Guard, 

Out_Guard => 0_Guard, 

Excep_Trigger => E_Trigger, 

Timer_Op => T_Op, 

Per, 



Per 

Fw 

Mcp 

Mrt 



=> 



=> Fw, 
=> 

=> 



Mcp, 

Mrt, 



Impl_Desc => Im_Desc) ; 



Temp_Op_Ptr := new Operator (Category 



=> Psdl_Operator , 
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Granularity => Composite) ; 



Temp_Op_Pt r . all := Temp_Op; 
end if; 

Bind_Operation (Op_Name, Temp_Op_Ptr, 0_Map) ; 

— reset everything after you are done, (the variables that have default 



else 

Put ( "Warning : The specif icat ion of operator ' '' ) ; 

Put_Line (Op_Name . s & was not given, implementation ignored."); 
end i f ; 

end Add_Op_Impl_To_Op_Map; 

# # %procedure_parse 
end Parser; 



values ) 



Gr 

D_St ream 

Tmrs 

Trigs 

E_Guard 

0_Guard 

E_Trigger 

T_Op 

Per 

Fw 

Mcp 

Mrt 

Im Desc 



Empty_Psdl_Graph; 
Empty_Type_Declaration; 
Empty_Id_Set ; 
Empty_Trigger_Map ; 
Empty_Exec_Guard_Map; 
Empty_Out_Guard_Map ; 
Empty_Excep_Trigger_Map; 
E mp t y _T i me r _Op_Ma p ; 
Empty_Timing_Map; 
Empty_Timing_Map; 
Empty_Timing_Map; 
Empty_Timing_Map; 
EMpty_Text ; 
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APPENDIX D. MAIN PROGRAM FOR THE EXPANDER 



— expander. a 



Unit name 
File name 
Author 
Address 
Date Created 
Last Update 



Main procedure for the PSDL Expander 
expander . a 
Suleyman Bayramoglu 
bayram0taurus .cs .nps .navy.mil 
July 1991 

{Mon Sep 23 23:16:31 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada ver. 6.0(c) 



— Keywords : PSDL expander, multi-level to two-level 

— Abstract : 

This file contains m.ain driver procedure for the expander 

— Uses command Unix command line interface, non-standard package U_ENV 



Revision history 

--$Source : /n/gemini/work/bayram/AYACC/parser /RCS/expander . a, v $ 
--$Revision: 1.2 $ 

— $Date: 1991/09/24 06:26:50 $ 

— $Author: bayram $ 



with U_Env, Psdl_Component_Pkg, 
Psdl_Tokens, Parser, 

Text_Io, Psdl_Io; 

use Text_Io, Psdl_Component_Pkg; 
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procedure Expander is 



The_Psdl_Component 

: Psdl_Component_Pkg . Psdl_Program : = Empty_Psdl_Program/ 



begin 



— Command: ’’expander" or ’’<command> I expander", 

— reads the standard input, outputs to standard output 
if U_Env.Argc = 1 then 

Put_Line ( "Parsing stdin, terminate with "^D") ; 

Psdl_Io.Get (The_Psdl_Component ) ; 

Put_Line ( "Psdl ADT created for stdin,"); 

Put_Line(" Input listing file is left in file 'stdin . 1st ’") ; 

— Expand ( ) ; 

Psdl_Io.Put (The_Psdl_Component ) ; 

— Put_Line { "Expanded Psdl source code is generated form Psdl ADT,"); 

— Command: "expander <file-name> 

— input is the the file whose name is given , and 
-- output is the standard output 

elsif U_Env.Argc = 2 then 

if U_Env . Argv ( 1 ) . S = "-help" or U_Env . Argv ( 1 ) . S = ”-h" then 
Put_Line ( "Usage : expander [input_file] [-o output_f ile ] " ) ; 
else 

Psdl_Io . Get (F_Name => U_Env.Argv (1) .S, 

Item => The_Psdl_Component ) ; 



-- Expand ( ) ; 

Psdl_Io .Put (The_Psdl_Component ) ; — output the expanded PSDL file 

end if; 

— Command: "expander <input-file> -o <out-file> 

— input and output is/from unix files 
elsif U_Env.Argc = 4 then 

if U_Env . Argv (2 ) .S = "-o" then 

Put_Line ( "Parsing '" & U_Env . Argv ( 1 ) . S & "' "); 

Psdl_Io . Get (U__Env . Argv ( 1 ) .S, U_Env . Argv (3) .S, The_Psdl_Component) ; 
Put_Line ( "Psdl ADT created for " & U_Env . Argv ( 1 ) . S ) ; 

Put_Line(" Input listing file is left in file '" & 

U_Env . Argv ( 1 ) . S & ".1st”'); 

— Expand ( ) ; 

Psdl_Io . Put (The_Psdl_Component ) ; 

Put ( "Expanded Psdl source code is generated form Psdl ADT and left"); 

Put_Line("in file '" & U_Env . Argv ( 3) . S & "’"); 
else 



129 



Put^Line ( "unknown option; Usage: expander [input^file] [-o output^f ile ] " ) ; 

end if; 
else 

Put_Line ( "Usage : expander [input_file] [-o output_f ile] " ) ; 
end if; 

exception 

when Name_Error => 

Put_Line ( "Error : can’t open & U_Env. Argv (1) .S &"*"); 
when Use_Error => 

Put_Line ( "Error : can't create output file. Permission denied."); 

when Psdl_Tokens . Syntax_Error => 

Put_Line ( "Parsing aborted due to Syntax Error"); 



when Parser . Semantic_Error => 

Put Line ( "Semantic Error, parsing aborted"); 



end Expander; 
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APPENDIX E. PACKAGE PSDL lO 



— psdl_io.a 



Unit name 
File name 
Author 
Address 
Date Created 
Last Update 



Aflex specification file for PSDL parser 

psdl_lex . 1 

Suleyman Bayramoglu 

bayram0taurus . cs . nps . navy .mil 

Ap r i 1 1991 

{Wed Oct 24 23:53:05 1990 - bayram} 



Machine/System Compiled/Run on 



Sun4 , SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : input/output PSDL program 

— Abstract : 

THis file is the package that provides a standard I/O for 

— PSDL programs (This was an easy start to parser business!) 

Revision history 

--$Sourcc: /n/gemini/work/bayram/AYACC/parser/RCS/psdl_io . a, v $ 
--$Revision: 1.4 $ 

— $Date: 1991/09/24 06:46:48 $ 

— $Author: bayram $ 



with Parser, Psdl_Component_Pkg, A_St rings; 
package Psdl_IO is 
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procedure GET 

Reads the psdl source file, parses it and creates the PSDL ADT 
Input file is line numbered and saved into a file 
input file name .1st in the current directory. So if 
there is no write permission for that directory, exception 
Use_Error is raised and program aborts, if the second argument 
is passed psdl file resulted form PSDL ADT is written into a 
file with that name. 



procedure Get 

( F_Name : in String; 0_F_Name : in String := 
Item : out Psdl_Component_Pkg . Psdl_Program ) 
renames Parser . Get / 



procedure GET 

Reads the standard input, parses it and creates the 
PSDL ADT. Input file is line numbered and saved into a 
file input file name .1st in the current directory. So if 
there is no write permission for that directory, exception — 
Use_Error is raised and program aborts. 



procedure Get 

( Item : out Psdl_Component_Pkg . Psdl_Program ) 
renames Parser. Get; 



procedure PUT 

— Extract the text representation of PSDL program from 

— the PSDL ADT and outputs as a legal PSDL source file — 

— The output is always to standard output, but command line 

— switch when invoking the expander, directs renames the — 

— renames the standard output to as the given UNIX file 

— A modification can be done to this procedure in package 

— Psdl_Component_Pkg, (separate procedure put_psdl) 

— to use a file instead of standard output for flexibity 

— The best thing to provide two procedures one for stdout 

— the other for file out, and it is fairly eeasy to do. 
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procedure Put 

( P : in Psdl_Component_Pkg . Psdl__P rogram ) 
renames Psdl_Component_Pkg . Put_Psdl ; 

end Psdl 10; 
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APPENDIX F. SPECIFICATION OF PSDL ADT 



- psdl_types . a 



— Unit name 
-- File name 

— Author 

— Date Created 

— Modified by 
-- Address 


Specification of PSDL ADT 
psdl_types . a 

Valdis Berzins (berzins0taurus.cs.nps.navy.mil) 
December 1990 
Suleyman BAyramoglu 
bayramOtaurus . cs . nps . navy.mil 



— Last Update : {Tue Sep 24 00:04:52 1991 - bayram} 

— Machine/System Compiled/R.un on : Sun4, SunOs 4,1.1, 






Verdix Ada version 6.0 (c) 


— Keywords : 


abstract data type, PSDL program 



— Abstract : 

This package is the specification for the PSDL ADT 
Revision history 

— $Source : /n/gemini/work/bayram/AYACC/parser/RCS/psdl_types . a, v $ 
— $Revision: 1.13 $ 

— $Date: 1991/09/24 04:51:13 $ 

— $Author: bayram $ 



with PSDL_CONCRETE_TYPE_PKG; 
use PSD L_CONCRETE_T YP E_P KG ; 
with PSDL_GRAPH_PKG; 
use PSDL_GRAPH_PKG; 

with GENERIC_MAP_PKG; — defines a generic map type 
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package PSDL_COMPONENT_PKG is 

— BY REQUIREMENTS clauses are ignored in this version. 

— The substructure of expressions is not represented in this version. 



-- Discriminant types. 

type COMPONENT_TYPE is (PSDL_OPERATOR, PSDL_TYPE) ; 
type IMPLEMENTATION_TYPE is (ATOMIC, COMPOSITE) ; 

— Main types . 
type PSDL_COMPONENT 

(CATEGORY : COMPONENT_TYPE := PSDL_OPERATOR; 

GRANULARITY : IMPLEMENTATION_TYPE := COMPOSITE) is private; 

— The initializations make c: psdl_component a 1 

— egal variable declaration 

— even though psdl_component is an unconstrained type, 
type COMPONENT_PTR is access PSDL_COMPONENT; 

subtype OPERATOR is PSDL_COMPONENT; — (category => psdl_operator ) . 
type OP_PTR is access OPERATOR; 

subtype DATA_TYPE is PSDL_COMPONENT; — (category => psdl_type) 

subtype ATOMlC_COMPONENT is PSDL_COMPONENT; -- (granularity => atomic) 



subtype AT0MIC_0PERAT0R is 



OPERATOR (CATEGORY 

GRANULARITY 



=> PSDL_OPERATOR, 
=> ATOMIC) ; 



subtype COMPOS I TE_OPERATOR is OPERATOR (CATEGORY => 

GRANULARITY => 



PSDL_OPERATOR, 
COMPOSITE) ; 



subtype ATOMIC_TYPE is DATA_TYPE 



(CATEGORY => PSDL_TYPE, 
GRANULARITY => ATOMIC) ; 



subtype COMPOS ITE_TYPE is DATA_TYPE 



(CATEGORY => PSDL_TYPE, 
GRANULARITY => COMPOSITE) ; 



— needed for generic map package 
function Eq(x, y: Psdl__Id) return BOOLEAN; 



function Eq(x, y: 



Component_Ptr ) return BOOLEAN; 



function Eq(x 



y: Op_Ptr) return BOOLEAN; 



package PSDL_PROGRAM_PKG is 

new GENERIC_MAP_PKG(KEY => PSDL_ID, 

RESULT => COMPONENT_PTR, 
Eq_Key => Eq, 

Eq_Res => Eq) ; 

type PSDL_PROGRAM is new PSDL_PROGRAM_PKG .MAP; 

— A psdl program is an environment that binds 

— psdl component names 

— to psdl component definitions. 

— The operations on psdl_programs are the same as 

— the operations on maps. 

function EMPTY_PSDL_PROGRAM return PSDL__PROGRAM; 

— returns an empty psdl_program. 

package OPERATION_MAP_PKG is 

new GENERIC_MAP_PKG(KEY => PSDL_ID, 

RESULT => OP_PTR, 
Eq_Key => Eq, 
Eq_Res => Eq) ; 

type OPERATION_MAP is new OPERATION_MAP_PKG .MAP; 

— A operation map is an environment that binds 

— psdl operator names 

— to psdl operator definitions. 

function EMPTY_OPERATION_MAP return 0PERATI0N_MAP; 

— returns an empty operation_map . 



— exception declarations 
INITIAL_STATE_UNDEFINED 


: exception; 


NO_DATA_STRUCTURE 


: exception; 


I NP UT_RE DE C L ARE D 


: exception; 


OUTPUT_REDECLARED 


: exception; 


S T AT E_RE DEC L ARE D 


: exception; 


INITIAL_VALUE_REDECLARED 


: exception; 


EXCEPTION_REDECLARED 


: exception; 


SPECIFIED_MET_REDEFINED 


: exception; 
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NOT A SUBCOMPONENT 



: exception; 



PERIOD REDEFINED 



: exception; 



FINISH WITHIN REDEFINED 



: exception; 



MINIMUM_CALLING_PERIOD_REDEFINED : exception; 

MAXIMUM_RESPONSE_TIME_REDEFINED : exception; 

-- The following exceptions signal failures of 
-- explicit runtime 

-- checks for violations of subtype constraints. 

— This is needed because Ada does not allow partially 

— constrained types: 

— if any discriminants are constrained, 

-- then all must be constrained. 

NOT_AN_OPERATOR : exception; 

— Raised by operations on psdl operators 

— that have an actual parameter 

-- of type operator with category = psdl_type. 

NOT_A_TYPE : exception; 

-- Raised by operations on psdl data types 

— that have an actual parameter 

-- of type data_type with category = psdl_operator . 

NOT_AN_ATOMIC_COMPONENT : exception; 

— Raised by operations on atomic components 

— that have an actual parameter 

-- of type atomic_component with granularity = composite. 

-- operations on all psdl components 

function COMPONENT_CATEGORY (C : PSDL_COMPONENT) 
return COMPONENT_TYPE; 

— Indicates whether c is an operator or a type. 

function COMPONENT_GRANULARITY (C : PSDL_COMPONENT) 
return IMPLEMENTATION_TYPE; 

— Indicates whether c is atomic or composite. 

function NAI^E(C : PSDL_COMPONENT) return PSDL_ID; 

— Returns the psdl name of the component . 
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function GENERIC_PARAMETERS (C : PSDL_COMPONENT) 
return TYPE_DECLARATION; 

— Returns an empty type_declaration 

— if no generic parameters are declared. 

function KEYWORDS (C : PSDL_COMPONENT) 
return ID_SET; 

— Returns an empty set if no keywords are given. 

function INFORMAL_DESCRIPTION (C : PSDL_COMPONENT) 
return TEXT; 

— Returns an empty string 

— if no informal description is given. 

function AXIOMS (C : PSDL__COMPONENT) 
return TEXT; 

— Returns an empty string 

— if no formal description is given. 



operations on psdl operators 



function INPUTS (0 : OPERATOR) 

return TYPE_DECLARATION; 

— Returns an empty type_declaration 

— if no inputs are declared. 

function OUTPUTS (0 : OPERATOR) 

return TYPE_DECLARATION; 

— Returns an empty type_declaration 

-- if no outputs are declared. 

function STATES (0 : OPERATOR) 

return TYP REDECLARATION; 

— Returns an empty type_declaration 

— if no state variables are declared. 

function INITIAL_STATE (0 : OPERATOR; 

V : VARIABLE) 
return EXPRESSION; 

— Raises initial_state_undef ined 

— if V is not initialized. 



function GET_INIT_MAP (0 : OPERATOR) 
return INIT_MAP; 
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returns an empty init_map 
if no initialization exists. 



function EXCEPTIONS (0 : OPERATOR) 
return ID_SET; 

— Returns an empty set if no exceptions are declared. 

function SPECIFIED_MAXIMUM_EXECUTION_TIME (0 : OPERATOR) 
return MILLISEC; 

— The maximum execution time given in the specification of o. 

— See also required_maximum_execution_time . 

— Returns zero if no maximum execution time is declared. 



procedure 



— Adds a 

— Raises 



ADD_INPUT (STREAM : in PSDL__ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) ; 

binding to the inputs map. 

input_redeclared if stream is already in inputs (o). 



procedure ADD_OUTPUT ( STREAM : in PSDL_ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) ; 

— Adds a binding to the outputs map. 

— Raises output_redeclared if stream is already in outputs (o) . 



procedure AD D_STATE (STREAM : in PSDL_ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) ; 

— Adds a binding to the states map. 

— Praises state_redeclared if stream is already in states (o). 



procedure ADD_INITIALIZATION (STREAM : in PSDL_ID; 

E : in EXPRESSION; 

0 : in out OPERATOR) ; 

— Adds a binding to the init map. 

— Raises init ial_value_redeclared if stream is 

— already bound in the init map. 



procedure ADD_EXCEPTION (E : PSDL_ID; 

0 : in out OPERATOR) ; 

— Raises except ion_redeclared if stream is 
-- already in exceptions (o) . 



procedure SET_SPECIFIED_MET (MET : MILLISEC; 

0 : in out OPERATOR) ; 
— Raises specif ied_met_redefined if specif ied_met 
-- is already non-zero. 
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— Operations on all atomic psdl componets. 



-- Create an atomic operator 

function ADA NAME (A ; ATOMIC_COMPONENT) return ADA_ID; 



function MAKE_ATOMIC_OPERATOR 
(PSDL_NAME 
ADA_NAME 
GEN_PAR 

KEYWORDS 

INFORMAL_DESCRIPTION, 
INPUT, OUTPUT, STATE 

INITIALIZATION_MAP 

EXCEPTIONS 

SPECIFIED_MET 

return ATOMIC OPERATOR; 



: PSDL_ID; 

: ADA_ID; 

: TYPE_DECLARATION 

:= EMPTY_TYPE_DECLARATION; 

; ID_SET := EMPTY_ID_SET; 
AXIOMS : TEXT := EMPTY_TEXT; 

: TYPE_DECLARATION 

:= EMPTY_TYPE_DECLAPvATION; 

: INIT_MAP EMPTY_INIT_MAP; 

: ID_SET EMPTY_ID_SET; 

: MILLISEC 0) 



— Create an atomic type 
function MAKE_ATOMIC_TYPE 
(PSDL_NAME 
ADA_NAME 
MODEL 
OPERATIONS 
GEN_PAR 

KEYWORDS 

INFORMAL_DESCRIPTION, 
return ATOMIC TYPE; 



; PSDL_ID; 

: ADA_ID; 

: TYPE_DECLARATION; 

: OPERATION_MAP; 

: TYPE_DECLARATION 

:= EMPTY_TYPE_DECLARATION; 
: ID_SET := EMPTY_ID_SET; 
AXIOMS : TEXT EMPTY TEXT) 



— Operations on composite operators. 



function GRAPH (CO : COMPOS I TE_OPERATOR) 
return PSDL_GRAPH; 

function STREAl-IS(CO : COMPOS I TE_OPERATOR) 
return TYPE_DECLARATION; 
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— Returns an empty type_declarat ion 
-- if no local streams are declared. 

function TIMERS (CO : COMPOS ITE_OPERATOR) 
return ID_SET; 

— Returns an empty set if no timers are declared. 

function GET_TRIGGER_TYPE 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPEPJ^TOR) 

return TRIGGER_TYPE; 

— Returns the type of triggering condition for 

— the given component operator. 

— Derived from the control constraints, 

— result is ’’none" if no trigger. 

— Raises not_a_subcomponent if component_op 

— is not a vertex in graph (co). 



function EXECUTION_GUARD 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return EXPRESSION; 

— Returns the IF part of the triggering condition for the 

— component operator, "true" if no triggering 

— condition is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

function OUTPUT_GUARD 

(COMPONENT_OP, 

OUTPUT_STREAM : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return EXPRESSION; 

— Returns the IF part of the output constraint 
for the component operator 

— for each output stream mentioned in the constraint, 

— "true" if no output constraint with the stream is given. 

-- Raises not_a_subcomponent if component_op is not a 

— vertex in graph (co) . 

function EXCEPTION_TRIGGER 
(COMPONENT_OP, 

EXCEPTION_NAME : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return EXPRESSION; 

— Returns the IF part of the exception trigger for 
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— the component operator 

— and exception name, "true" if there is an unconditional 

— exception trigger 

— in the control contraints, "false" if no exception 

— trigger is given 

— for component_op in the control constraints. 

— Raises not_a_subcomponent if component_op 

— is not a vertex in graph (co). 

function TIMER_OPERATION 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return TIMER_OP_SET ; 

-- Returns the timer_op part of the control 

— constraint for the 

— component operator, "none" if no timer 

— operation is given. 

— Raises not_a_subcomponent if component_op 

— is not a vertex in graph (co) . 

function PERIOD 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return MILLISEC; 

— Returns the period part of the control constraint for the 

— component operator, zero if no period is given. 

— Raises not_a_subcomponent if component_op is not 

— a vertex in graph (co). 

function FINISH_WITHIN 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return MILLISEC; 

— Returns the f inish_within part of the control 

— constraint for the 

— component operator, zero if no f inish_within is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

function MINIMUM_CALLING_PERIOD 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return MILLISEC; 

— Returns the minimum calling period part of the 

— control constraint for the 

— component operator, zero if no minimum calling 



142 



— period is given. 

-- Raises not_a_subcomponent if component_op is not 

— a vertex in graph (co) . 

function MAXIMUM_RESPONSE_TIME 

(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return MILLISEC; 

— Returns the maximum_response_time part of the 

— control constraint for the 

— component operator^ zero if no 

— maximum_response_t ime is given. 

— Raises not_a_subcomponent if component_op 

— is not a vertex in graph (co). 

function REQUIRED_1*1AXIMUM_EXECUTI0N_TIME 
(COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return MILLISEC; 

— Returns the maximum execution time part of the 

— control constraint for the 

— component operator, zero if no maximum execution time is given 

— in the graph. This includes time used by the implementations 

— of the control constraints and stream operations, and should be 
-**- greater than or equal to the specif ied_maximum___execut ion time for 

— the component operator if it is defined (greater than zero) . 

-- Raises not_a_subcomponent if component_op is not a vertex in 

— graph (co) . 



function LATENCY 

(PRODUCER_OP, 

CONSUMER_OP, 

STREAM_NAME : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return MILLISEC; 

— Returns the timing label on the edge from the producer operator 
-- to the consumer operator in the graph, zero if none. 

— Represents the maximum data transmission delay allowed for 

— the data stream, for modeling network delay in 
-- distributed systems. 

— Raises not_a_subcomponent if component_op is not a vertex 

— in graph (co) . 
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— Creates a composite operator 
function MAKE_COMPOSITE_OPERATOR 
(NAME 
GEN_PAR 

KEYWORDS 

INFORMAL_DESCRIPTION, AXIOMS 
INPUT, OUTPUT, STATE 

INITIALIZATION_MAP 

EXCEPTIONS 

SPECIFIED_MET 

GRAPH 

STREAMS 

TIMERS 

TRIGGER 

EXEC_GUARD 

OUT_GUARD 

EXCEP_TRIGGER 

TIMER_OP 

PER, FW, MCP, MRT 
impl_desc 

return COMPOS I TE_OPERATOR; 



PSDL_ID; 

TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATION; 
ID_SET := EMPTY_ID_SET; 

TEXT := EMPTY_TEXT; 
TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATION; 
INIT_MAP := EMPTY_INIT_MAP; 
ID_SET := EMPTY_ID_SET; 
MILLISEC := 0; 

PSDL_GRAPH 

:= EMPTY_PSDL_GRAPH; 

TYPE_DECLARATION 

:= EMPTY_TYPE_DECLARATION; 

ID_SET := EMPTY_ID_SET; 

TRIGGER_MAP 

:= EMPTY_TRIGGER_MAP; 

EXEC_GUARD_MAP 

:= EMPTY_EXEC_GUARD_MAP; 

OUT_GUARD_MAP 

:= EMPTY_OUT_GUARD_MAP; 

EXCEP_TRIGGER_MAP 

:= EMPTY_EXCEP_TRIGGER_MAP; 

TIMER_OP_MAP 

EMPTY_TIMER_OP_MAP; 
TIMING_MAP 
:= EMPTY_TIMING__MAP; 

: text:= empty_text) 



procedure ADD_VERTEX (OPNAME 

CO 

MET 

procedure ADD_EDGE(X, Y 

STREAM 

CO 

LATENCY 

procedure ADD_STREAM(S 

T 

CO 



in PSDL_ID; 

in out COMPOS ITE_OPERATOR; 
in MILLISEC := 0) ; 

in PSDL_ID; 
in PSDL_ID; 

in out COMPOS ITE_OPERATOR; 
in MILLISEC := 0) ; 

in PSDL_ID; 
in TYPE_NAME; 

in out COMPOSITE OPERATOR) ; 
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procedure ADD_TIMER(T 

CO 



: in PSDL_ID; 

: in out COMPOSITE OPERATOR) ; 



procedure SET_TRIGGER_TYPE (OP_ID : in 

T : in 

CO : in 

procedure SET_EXECUTION_GUARD (OP_ID : in 

E : in 

CO : in 

procedure SET_OUTPUT_GUARD (OP_ID : in 

STREAT4 : in 

E : in 

CO : in 

procedure SET_EXCEPTION_TRIGGER (OP_ID : in 

EXCEP : in 

E : in 

CO : in 



procedure ADD_TIMER_OP (OP_ID, 

TIMER_ID 
TOP 
E 

CO 

procedure SET_PERIOD (OP_ID 

P 

CO 

— Raises period_redef ined if 



PSDL_ID; 

TRIGGER_TYPE; 

out COMPOS ITE_OPERATOR) 

PSDL_ID; 

EXPRESSION; 

out COMPOS ITE_OPERATOR) 

PSDL_ID; 

PSDL__ID; 

EXPRESSION; 

out COMPOS ITE_OPERATOR) 

PSDL_ID; 

PSDL_ID; 

EXPRESSION; 

out COMPOSITE OPERATOR) 



in PSDL_ID; 
in TIMER_OP_ID; 
in EXPRESSION; 
in out COMPOS ITE_OPERATOR) 

in PSDL_ID; 
in MILLISEC; 

in out COMPOS ITE_OPERATOR) ; 
the period is non-zero. 



procedure SET_FINISH_WITHIN (OP_ID : in PSDL_ID; 

FW : in MILLISEC; 

CO : in out COMPOS ITE_OPERATOR) ; 
— Raises f inish_within_redef ined if the f inish_within 
-- is non-zero. 



procedure SET_MINIMUM_CALLING_PERIOD 

(OP_ID : in PSDL_ID; 

MCP : in MILLISEC; 

CO : in out COMPOS ITE_OPERATOR) ; 

-- Raises miniTnum_calling_period_redef ined if the 
-- minimum_calling_period is non-zero. 
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procedure SET_MAXIMUM_RESPONSE_TIME 

(OP_ID : in PSDL_ID; 

MRT : in MILLISEC; 

CO : in out COMPOS I TE_OP ERATOR ) ; 

— Raises max imum_response_time_rede fined if the 

— maximum_response_t ime is non-zero. 



— Operations on all psdl types. 
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function MODEL (T : DATA_TYPE) 

return TYPE_DECLARATION/ 

— Returns the conceptual representation declared in 
-- the specification part, 

— empty if not given. 

function OPERATIONS (T : DATA_TYPE) 
return OPERATION__MAP ; 

— Returns an environment binding operation names 

— to operation definitions, 

— an empty map if the type does not define any operations. 



— Operations on composite psdl data types. 



function DATA_STRUCTURE (T : COMPOS I TE_TYPE) 
return TYPE_NAME; 

— Returns the data structure declared in the 
-- psdl implementation part, 

-- raises no_data_st ructure if the type is 

— implemented in Ada. 



— Create a composite type 
function MAKE_COMPOSITE_TYPE 
(NAME 
MODEL 

DATA_STRUCTURE 

OPERATIONS 

GEN_PAR 

KEYWORDS 

INFOR14AL_DESCRIPTION, 

AXIOMS 

return COMPOSITE TYPE; 



PSDL_ID; 

TYPE_DECLARATION; 

TYPE_NAME; 

OPERATION_MAP; 

TYPE_DECLA RATION 
:= EMPTY_TYPE_DECLAPJVTION; 
ID_SET := EMPTY_ID_SET; 

TEXT := EMPTY_TEXT) 



— print out the psdl program 
procedure PUT_PSDL(P: IN PSDL PROGRAM); 



private 

type PSDL_COMPONENT 

(CATEGORY : COMPONENT_TYPE := PSDL OPERATOR; 
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GRANULARITY : IMPLEMENTATION_TYPE := COMPOSITE) is 



record 

NAME 

GEN_PAR 

KEYW 

INF_DESC, AX 
case CATEGORY is 

when PSDL_OPERATOR => 
INPUT, OUTPUT, STATE 
INIT 
EXCEP 
SMET 

case GRANULARITY is 
when ATOMIC => 
0_ADA_NAME 
when COMPOSITE => 

G 

STR 

TIM 

TRIG 

EG 

OG 

ET 

TIM_OP 

PER, FW, MCP, MRT 
IMPL_DESC 

end case; 
when PSDL_TYPE => 

MDL 

OPS 

case GRANULARITY is 
when ATOMIC => 
T_ADA_NAME 
when COMPOSITE => 
DATA_STR 
end case; 
end case; 
end record; 

end PSDL_COMPONENT_PKG; 



PSDL_ID; 

TYPE_DECLARATION; 

ID_SET; 

TEXT; 



T YP E_D E CL ARAT I ON ; 
INIT_MAP; 

ID_SET; 

MILLISEC; 



: ADA_ID; 

: PSDL_GRAPH; 

: TYPE_DECLARATION; 

: ID_SET; 

: TRIGGER_MAP; 

: EXEC_GUARD_MAP; 

: OUT_GUARD_MAP ; 

: EXCEP_TRIGGER_MAP; 

: TIMER_OP_MAP; 

: TIMING_MAP; 

: TEXT; — description in 

— the implementation part 



: T YP E_D E C LARAT I ON ; 
: OPERATION_MAP; 



: ADA_ID; 

: TYPE NAME; 
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APPENDIX G. IMPLEMENTATION OF PSDLADT 



— psdl_typeb . a 



Unit name 
File name 
Author 

Date Created 
Modified by 
Address 
Last Update 



Implementation of PSDL ADT 
psdl_typeb . a 

Valdis Berzins (berzins0taurus . cs . nps . navy .mil) 

December 1990 

Suleyman BAyramoglu 

bayram0taurus . cs . nps . navy.mil 

{Tue Sep 24 00:04:52 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : abstract data type, PSDL program 

— Abstract : 

This package is the implementation for the PSDL ADT 
Revision history 



--$Source : 

— /n/gemini/work/bay ram/AYACC/parser/psdl_ada . lib/RCS/psdl_typeb . a, v $ 
— $Revision: 1.15 $ 

— $Date: 1991/09/24 08:02:15 $ 

— $Author: bayram $ 



with text_io, a_strings; 
use text_io; 

package body PSDL_COMPONENT_PKG is 



-- the following functions are provided for ' 

— instations of generic packages (map, set, sequence) 
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function Eq(x, y: Psdl_Id) return BOOLEAN is 
begin 

return (X . S = Y . S) ; 
end Eq; 



function Eq(x, y: Component_Ptr) return BOOLEAN is 
begin 

return (X.Name.s = Y.Name.s); 
end Eq; 

function Eq(x, y: Op_Ptr) return BOOLEAN is 
begin 

return (X.Name.s = Y.Name.s); 
end Eq; 



— returns an empty operation_map . 

function EMPTY_OPERATION_MAP return OPERATION_MAP is 
M : OPERATION_MAP; 
begin 

CREATE (null, M) ; — default value of the map is the null pinter 

return M; 

end EMPTY_OPERATION_MAP; 



-- returns an empty psdl_program. 

function EMPTY_PSDL_PROGRAM return PSDL_PROGRAM is 
P : PSDL_PROGRAM; 

begin 

CREATE (null, P) ; — default value is the null pinter 

return P; 

end EMPTY_PSDL_PROGRAM; 

+ + ★ + FOR REFERENCE ONLY ■*^-*<''*:-*^'*c'*:'*^-*^**-*^*-*^-*<-'*^'^-*<^'*^'^*-^**-*^'*^ 

** + * + + ** + ★ + ★★ EXCEPTION LISTING ★■*' + ■*■***-*'★*■*■★★★★'*'★**'*■+* + ★★ 

— * initial_state_undef ined : exception; 

— * no_data_structure : exception; 

— * input_redeclared : exception; 

— * output_redeclared : exception; 

— * state_redeclared : exception; 

— * initial_value_redeclared: exception; 
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— ^ except ion_rede dared : exception; 

— ^ specif ied_met__redefined : exception; 

— not_a_subcomponent : exception; 

— ^ period_redef ined : exception; 

— ^ f inish_within_redef ined : exception; 

— * minimum_calling_period_redef ined : exception; 

— * maximum_response_time_redef ined : exception; 

— + — The following exceptions signal failures 

— — of explicit runtime 

— * — checks for violations of subtype constraints. 

— * — This is needed because Ada does not allow 

— * — partially constrained types: 

— •* __ j_f 3ny discriminants are constrained, 

— ★ — then all must be constrained. 

— * not_an_operator : exception; 

— * — Raised by operations on psdl operators that 

— — have an actual parameter 

of type operator with category = psdl_type. 

— not_a_type: exception; 

— — Raised by operations on psdl data types that 

— — have an actual parameter 

— — of type data_type with category = psdl_operator . 

— not_an_atomic_component : exception; 

— — Raised by operations on atomic components that 

— — have an actual parameter 

— — of type atomic_component with granularity = composite. 



— operations on all psdl components 



-- Indicates whether c is an operator or a type, 
function COMPONENT_CATEGORY (C : PSDL_COMPONENT) 
return COMPONENT TYPE is 



begin 

return C. CATEGORY; 
end COMPONENTCATEGORY; 



-- Indicates whether c is atomic or composite, 
function COMPONENT_GPJ^NULARITY (C ; PSDL_COMPONENT) 
return IMPLEMENTATION TYPE is 
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begin 

return C . GRANULARITY ; 
end COMPONENT GRANULARITY; 



— Returns the psdl name of the component, 
function NAME(C : PSDL_COMPONENT) 
return PSDL_ID is 

begin 

return C.NAME; 
end NAME; 



— Returns an empty type_declaration if no 

— generic parameters are declared 

function GENERIC_PARAMETERS (C : PSDL_COMPONENT) 
return TYPE DECLARATION is 



begin 

return C.GEN_PAR; 
end GENERIC_PARAMETERS; 



— Returns an empty set if no keywords are given, 
function KEYWORDS (C : PSDL_COMPONENT) 
return ID_SET is 

begin 

return C.KEYW; 
end KEYWORDS; 



-- Returns an empty string if no informal description is given, 
function I NFORMAL_DE SCRIPT ION (C : PSDL_COMPONENT) 
return TEXT is 

begin 

return C . INF__DESC; 
end INFORMAL DESCRIPTION; 



— Returns an empty string if no formal description is given, 
function AXIOMS (C : PSDL_COMPONENT) 
return TEXT is 
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begin 

return C.AX; 
end AXIOMS; 



— operations on psdl operators */ 

— Returns an empty type_declarat ion if no inputs are declared, 
function INPUTS (0 : OPERATOR) 

return TYPE DECLARATION is 



begin 

if 0, CATEGORY /= PSDL_0PERAT0R then 
raise N0T_AN_0PERAT0R; 
else 

return 0. INPUT; 
end if; 
end INPUTS; 



function OUTPUTS (0 : OPERATOR) 

return TYPE_DECLARATION is 

— Returns an empty type_declaration if 

— no outputs are declared, 
begin 

if 0. CATEGORY /= PSDL_0PERAT0R then 
raise N0T_AN_0PERAT0R; 
else 

return 0. OUTPUT; 
end if; 
end OUTPUTS; 



function STATES (0 : OPERATOR) 

return TYPE_DECLARATION is 

— Returns an empty type_declarat ion if no 

— state variables are declared. 

X : TYPE_DECLARATION; 



begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
else 

return 0. STATE; 
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end if; 
end STATES; 



function INITIAL_STATE (0 : OPERATOR; V : VARIABLE) 
return EXPRESSION is 

— Raises init ial_state_undef ined if v is not initialized, 
begin 

if 0. CATEGORY /= PSDL_0PERAT0R then 
raise NOT_AN_OP ERATO R; 

elsif not INIT_MAP_PKG .MEMBER (V, O.INIT) then 
raise INITIAL_STATE_UNDEFINED; 
else 

return INIT_MAP_PKG . FETCH (0 . INIT, V) ; 
end if; 

end INITIAL_STATE; 



function GET_INIT_MAP (0 : OPERATOR) return INIT_MAP is 

— Returns an empty init_map if no 

— initializations are declared. 

begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
else 

return O.Init; 
end if; 

end GET INIT MAP; 



function EXCEPTIONS (0 : OPERATOR) 
return ID_SET is 

-- Returns an empty set if no exceptions are declared, 
begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
else 

return O.EXCEP; 
end if; 

end EXCEPTIONS; 

function SPECIFIED_MAXIMUM_EXECUTION TIME (0 : OPERATOR) 
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return MILLISEC is 

— The maximum execution time given in the specification of o. 

— See also required_maximum_execution_time . 

— Returns zero if no maximum execution time is declared, 
begin 

if 0. CATEGORY /= PSDL_0PERAT0R then 
raise N0T_AN_0PERAT0R/ 
else 

return O.SMET; 
end if; 

end SPECIFIED_MAXIMUM_EXECUTION_TIME; 

procedure ADD_INPUT 

(STREAM : in PSDL_ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) is 

— Adds a binding to the inputs map. 

— Raises input_redeclared if stream is already in inputs (o). 
begin 

if 0. CATEGORY /= PSDL_0PERAT0R then 
raise N0T_AN_0PERAT0R; 

elsif TYPE_DECLARATION_PKG. MEMBER (STREAM, 0. INPUT) then 
raise I NPUT_REDE GLARED; 
else 

TYPE_DECLARATION_PKG. BIND (STREAM, T, 0. INPUT) ; 
end if; 

end ADD_INPUT; 

procedure ADD_OUTPUT (STREAM : in PSDL_ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) is 

— Adds a binding to the outputs map. 

— Raises output_redeclared if stream is already in outputs (o). 
begin 

if 0. CATEGORY /= PSDL_0PERAT0R then 
raise N0T_AN_0PERAT0R; 

elsif TYPE_DECLARATION_PKG. MEMBER (STREAM, 0. OUTPUT) then 
raise OUTPUT_REDECLARED; 
else 

TYPE_DECLARATION_PKG. BIND (STREAM, T, 0. OUTPUT) ; 
end if; 

end ADD_OUTPUT; 



procedure ADD_STATE (STREAM : in PSDL_ID; 

T : in TYPE_NAME; 

0 : in out OPERATOR) is 

— Adds a binding to the states map. 

— Raises state_redeclared if stream is already in states (o) . 
begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 

els if TYPE_DECLARATION_PKG . MEMBER ( STREAM, 0 . STATE) then 
raise STATE_REDECLARED/ 
else 

TYPE_DECLARATION_PKG.BIND (STRETVM, T, 0. STATE) / 
end if; 

end ADD STATE; 



procedure ADD_INITIALIZATION (STREAM : in PSDL_ID; 

E : in EXPRESSION; 

0 : in out OPERATOR) is 

— Adds a binding to the init map. 

Raises init ial_value_redeclared if stream is 
already bound in the init map. 

begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 

elsif INIT_MAP_PKG. MEMBER (STREAM, O.INIT) then 
raise INITIAL_VALUE_REDECLARED; 
else 

INIT_MAP_PKG. BIND (STREAM, E, O.INIT) ; 
end if; 

end ADD_INITIALIZATION; 

procedure ADD_EXCEPTION (E : PSDL_ID; 

0 : in out OPERATOR) is 

— Raises exception_redeclared if stream is already in 

exceptions (o) . 

begin 

if 0. CATEGORY /= PSDL OPERATOR then 
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raise NOT_AN_OPERATOR/ 
elsif ID_SET_PKG. MEMBER (E, O.EXCEP) then 
raise EXCEPTION_REDECLARED; 
else 

ID_SET_PKG. ADD (E, O.EXCEP) ; 
end if; 

end ADD EXCEPTION; 



procedure SET_SPECIFIED_MET (MET : MILLISEC; 

0 : in out OPERATOR) is 

— Raises specif ied_met_redefined if 

— specif ied_met is already non-zero. 

begin 

if 0. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
elsif O.SMET /= 0 then 
raise INPUT_REDECLARED; 
else 

O.SMET MET; 
end if; 

end SET SPECIFIED MET; 



-- Operations on all atomic psdl componets . 

function ADA_NAME (A : ATOMIC_COMPONENT) 
return ADA ID is 



begin 

case A. GRANULARITY is 
when ATOMIC => 

case A. CATEGORY is 

when PSDL_OPERATOR -> 
return A . 0_ADA_NAME; 
when PSDL_TYPE => 

return A . T_ADA_NAME; 
end case; 
when COMPOSITE => 

raise NOT_AN__ATOMIC_COMPONENT; 
end case; 
end ADA_NAME; 

function MAKE_ATOMIC_OPERATOR 

(PSDL__NAME : PSDL ID; 
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ADA_NAME : 

GEN_PAR : 

KEYWORDS : 

INFORMAL_DESCRIPTICN : 
AXIOMS : 

INPUT, OUTPUT, STATE : 

INITIALlZATION_MAP : 
EXCEPTIONS : 

SPECIFIED_MET : 

return ATOMIC_OPERATOR is 

— Create an atomic operator. 

X : ATOMIC_OPERATOR; 

begin 

X.NAME := PSDL_NAME; 

X.O_ADA_NAME := ADA_NAME; 

X.GEN_PAR := GEN_PAR; 

X.KEYW ;= KEYWORDS; 

X.INF_DESC := INFORMAL_DESCRIPTION; 
X.AX := AXIOMS; 

X. INPUT ;= INPUT; 

X. OUTPUT := OUTPUT; 

X. STATE := STATE; 

X.INIT := INITIALIZATION_MAP; 

X.EXCEP := EXCEPTIONS; 

X.SMET := SPECIFIED_MET; 

return X; 

end MAKE_ATOMIC_OPERATOR; 



function MAKE_ATOMIC_TYPE 

(PSDL_NAME 
ADA_NAME 
MODEL 
OPERATIONS 
GEN_PAR 

KEYWORDS 

INFORMAL_DESCRIPTION, AXIOMS : TEXT := EMPTY_TEXT) 
return ATOMIC TYPE is 



; PSDL_ID; 

: ADA_ID; 

: TYPE_DECLARATION; 

: 0PERATI0N_MAP; 

: TYPE_DECLARATION 

:= EMPTY_TYPE_DECLARATION; 
: ID_SET := EMPTY_ID_SET; 



ADA_ID; 

TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATlON; 
ID_SET := EMPTY_ID_SET; 

TEXT := EMPTY_TEXT; 

TEXT := EMPTY_TEXT; 
TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATION; 
INIT_MAP := EMPTY_INIT_MAP; 
ID_SET := EMPTY_ID_SET; 
MILLISEC := 0) 



— Create an atomic type. 
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X ; ATOMIC TYPE; 



begin 

X.NAME := PSDL_NAME; 

X.T_ADA_NAME := ADA_NA1^E; 

X.MDL := MODEL; 

X.OPS := OPERATIONS; 

X.GEN_PAR := GEN_PAR; 

X.KEYW := KEYWORDS; 

X.INF_DESC ;= INFORMAL_DESCRIPTION; 
X.AX := AXIOMS; 

return X; 

end MAKE ATOMIC TYPE; 



-k -k -k -k -k -k -k-k~k'kk-~k-k-k-kkr~k-k-k-k-k-k-k-k-k-k'k-k-k-k-k-k kkr-k-k-k-k-k-k-k-k-k-k-k-k-k-k-k-kk 



— Operations on composite operators. 

function GRAPH (CO : COMPOS I TE_OPERATOR) 
return PSDL_GRAPH is 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 
return CO.G; 
end GRAPH; 

function STREAMS (CO : COMPOS I TE_OPERATOR) 
return TYPE__DECLARATION is 

— Returns an empty type_declarat ion if no local 

— streams are declared, 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

return CO.STR; 
end STREAMS; 

function TIMERS (CO : COMPOS I TE_OPERATOR) 
return ID_SET is 

— Returns an empty set if no timers are declared, 
begin 

if CO. CATEGORY /- PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 
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return CO. TIM; 
end TIMERS; 

function GET_TRIGGER_TYPE (COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return TRIGGER_TYPE is 

— Returns the type of triggering condition for the 

— given component operator. 

— Derived from the control constraints, 

— result is ’’none” if no trigger. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

T_RECORD: TRIGGER_RECORD; 

begin 

if CO. CATEGORY /== PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

if not HAS_VERTEX (COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 

elsif (not TRI GGER_MAP_P KG .MEMBER (COMP ONENT_OP, CO. TRIG)) then 
return NONE; 
else 

T_RECORD:= TRIGGER_MAP_PKG. FETCH (CO. TRIG, COMPONENT_OP ) ; 
return T_RECORD.TT; 
end if; 

end GET_TRIGGER_TYPE; 

function EXECUTION_GUARD (COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return EXPRESSION is 

— Returns the IF part of the triggering condition for the 

— component operator, "true" if no triggering 

— condition is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co) . 

NO_TRIGGERING : EXPRESSION; 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

NO_TRIGGERING.S := ’’true"; 

if not HAS_VERTEX(COMPONENT_OP, CO.G) then 
raise NOT_A_SUB COMPONENT; 

elsif (not EXEC_GUARD_MAP_PKG .MEMBER (COMPONENT_OP, CO. EG)) then 
return NO_TRIGGERING; 



160 



else 

return EXEC_GUARD_MAP__PKG . FETCH (CO . EG, COMPONENT_OP ) ; 
end if; 

end EXECUTION_GUARD; 

f unct ion OUTPUT_GUARD ( COMPONENT_OP , 

OUTPUT_STREAM : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return EXPRESSION is 

— Returns the IF part of the output constraint 

— for the component operator 

— for each output stream mentioned in the constraint, 

— "true" if no output constraint with the stream is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

TEMP_ID : OUTPUT_ID; 

NO_CONSTRAINT : EXPRESSION; 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

NO_CONSTRAINT.S := "true"; 

TEMP_ID.OP := COMPONENT_OP ; 

TEMP_ID. STREAM := OUTPUT_STREAM; 
if not HAS_VERTEX (COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 

elsif (not OUT_GUARD_MAP_P KG .MEMBER (TEMP_ID, CO.OG)) then 
return NO_CONSTRAINT; 
else 

return OUT_GUARD_MAP_PKG . FETCH (CO . OG, TEMP_ID) ; 
end if; 

end OUTPUT_GUARD; 

function EXCEPT ION_TRI GGER (COMPONENT_OP, 

EXCEPT ION_NAME : PSDL_ID; 

CO : COMPOS ITE^OPERATOR) 

return EXPRESSION is 

-- Returns the IF part of the exception trigger 

— for the component operator 

— and exception name, "true" if there is an 
-- unconditional exception trigger 

— in the control contraints, "false" if no 
-- exception trigger is given 

— for component_op in the control constraints. 

— Raises not_a_subcomponent if component_op is 
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— not a vertex in graph (co) . 

TEMP_ID ; EXCEP_ID; 

UNCONDITIONAL_EXCEPTION, NO_EXCEPTION ; EXPRESSION; 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

UNCONDITIONAL_EXCEPTION. S := "true"; 

NO_EXCEPTION.S := "false"; 

TEMP_ID.OP ;= COMPONENT_OP; 

TEMP_ID.EXCEP := EXCEPTION_NAME; 
if not HAS_VERTEX (COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 

elsif (not EXCEP_TRIGGER_MAP_PKG .MEMBER (TEMP_ID, CO.ET)) then 
return NO_EXCEPTION; 
else 

return EXCEP_TRIGGER_MAP_P KG. FETCH (CO.ET, TEMP_ID) ; 
end if; 

end EXCEPTION TRIGGER; 



function TIMER_OPERATION (COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 
return TIMER_OP_SET is 

-- Returns the timer_op_set from the control constraint for the 

— component operator, a empty set if no timer operation is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co) . 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 

elsif not HAS_VERTEX (COMPONENT_OP, CO.G) then 
raise NOT_A_SUB COMPONENT; 
else 

return TIMER_OP_MAP_PKG .FETCH (CO. TIM_OP, COMPONENT_OP) ; 
end if; 

end TIMER_OPERATION; 

function PERIOD (COMP ONENT_OP : PSDL_ID; 

CO ; COMPOSITE_OPERATOR) 

return MILLISEC is 

— Returns the period part of the control constraint for the 

— component operator, zero if no period is given. 
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— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co) . 

begin 

if not HAS_VERTEX(COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 
else 

return TIMING_MAP_PKG . FETCH (CO . PER, COMPONENT_OP) ; 
end if; 
end PERIOD; 

function FINISH_WITHIN (COMPONENT_OP : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 

return MILLISEC is 

— Returns the f inish_within part of the control 
-- constraint for the 

— component operator, zero if no f inish_within is given. 

-- Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

begin 

if not HAS_VERTEX(COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 
else 

return TIMING_MAP_PKG . FETCH (CO . FW, COMPONENT_OP ) ; 
end if; 

end FINISH_WITHIN; 

function MINIMUM_CALLING_PERIOD (COMPONENT_OP : PSDL_ID; 

CO : COMPOSITE_OPERATOR) 

return MILLISEC is 

— Returns the minimum calling period 

— part of the control constraint for the 

— component operator, zero if no minimum calling 
-- period is given. 

-- Raises not_a_subcomponent if component_op 

— is not a vertex in graph (co). 

begin 

if not HAS_VERTEX (COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 
else 

return TIMING_MAP_PKG . FETCH (CO .MCP, COMPONENT_OP ) ; 
end if; 

end MINIMUM_CALLING_PERIOD; 
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function MAXIMUM_RESPONSE_TIME (COMPONENT_OP : PSDL_ID; 

CO : COMPOS I TE_OPERATOR) 

return MILLISEC is 

— Returns the maximum_response_time part of the 

— control constraint for the 

— component operator, zero if no 

— maximum_response_time is given. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co) . 

begin 

if not HAS_VERTEX(COMPONENT_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 
else 

return TIMING_MAP_PKG . FETCH (CO .MRT, COMPONENT_OP ) ; 
end if; 

end MAXIMUM RESPONSE_TIME; 



function REQUIRED_MAXIMUM_EXECUTION_TIME (COMPONENT_OP : PSDL_ID; 

CO : COMPOSITE OPERATOR) 



return MILLISEC is 



— Returns the maximum execution time 

— part of the control constraint for the 

— component operator, zero if no maximum 

— execution time is given 

— in the graph. This includes time used by the implementations 

— of the control constraints and stream operations, 

— and should be 

— greater than or equal to the 

— specif ied_maximum_execution time for 

-- the component operator if it is defined (greater than zero) . 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

begin 

if not HAS_VERTEX(COMPONENT_OP, CO.G) then 
raise NOT_A_SUB COMPONENT, • 
else 

return 0; — just a stub 

end if; 

end REQU I RED_MAX IMUM_E XE CUT I ON__T I ME ; 
function LATENCY (PRODUCER OP, 
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CONSUMER_OP, 

STREAM_NA14E : PSDL_ID; 

CO : COMPOS ITE_OPERATOR) 
return MILLISEC is 



— Returns the timing label on the edge from the 

— producer operator 

— to the consumer operator in the graph, zero if none. 

— Represents the maximum data transmission delay allowed for 

— the data stream, for modeling network 

— delay in distributed systems. 

— Raises not_a_subcomponent if component_op is 

— not a vertex in graph (co). 

begin 

if not HAS_VERTEX (PRODUCER_OP, CO.G) 

or not HAS_VERTEX(CONSUMER_OP, CO.G) then 
raise NOT_A_SUBCOMPONENT; 
else 

return LATENCY (PRODUCER_OP , CONSUMER_OP, 

S TRE AM_N AME , CO . G ) ; 

end if; 
end LATENCY; 



function MAKE_COMPOSITE_OPERATOR 

(NAME 

GEN_PAR 

KEYWORDS 

INFOPliAL_DESCRIPTION 

AXIOMS 

INPUT, OUTPUT, STATE 

INITIALIZATION_MAP 

EXCEPTIONS 

SPECIFIED_MET 

GRAPH 

STREAMS 

TIMERS 

TRIGGER 

EXEC_GUARD 

OUT GUARD 



: PSDL_ID; 

: TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATION 
: ID_SET := EMPTY_ID_SET; 

: TEXT := EMPTY_TEXT; 

: TEXT := EMPTY_TEXT; 

: TYPE_DECLARATION 
:= EMPTY_TYPE_DECLARATION 
: INIT_MAP 

:= EMPTY_INIT_MAP; 

: ID_SET := EMPTY_ID_SET; 

: MILLISEC := 0; 

: PSDL_GRAPH 

:= EMPTY_PSDL_GRAPH; 

: TYPE_DECLARATION 
:= EMPTY_TYPE_DECLAPJVTION 
: ID_SET := EMPTY_ID_SET; 

: TRIGGER_MAP 

:= EMPTY_TRIGGER_MAP; 

: EXEC_GUARD_MAP 

:= EMPTY_EXEC_GUARD_MAP 
: OUT GUARD MAP 
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EXCEP TRIGGER 



TIMER_OP 

PER, FW, MCP, MRT 
IMPL_DESC 

return COMPOS I TE_OPERATOR is 
— Create a composite operator. 

X : COMPOS ITE_OPERATOR; 
begin 



X . name 


= name ; 


x.gen par 


= gen_par; 


X . keyw 


= keywords; 


X . inf_desc 


= informal description; 


X . ax 


= axioms; 


X . input 


= input; 


X . output 


= output; 


X . state 


= state; 


X . init 


= initialization map; 


X . excep 


= exceptions; 


X . smet 


= specif ied_met; 


x.g 


= graph; 


X . str 


= streams; 


X . tim 


= timers; 


X .trig 


= trigger; 


X . eg 


= exec_guard; 


X . og 


= out_guard; 


X . et 


= excep__trigger; 


x.tim_op 


= timer_op; 


X .per 


= per; 


X . f w 


= fw; 


X .mcp 


= mcp; 


x.mrt 


:= mrt; 



x.impl_desc : = impl_desc; 
return X; 

end MAKE_COMPOSITE_OPERATOR; 



procedure ADD_VERTEX (OPNAME : in PSDL_ID; 

CO : in out COMPOS I TE_OPERATOR; 

MET : in MILLISEC := 0) is 



:= EMPTY_OUT_GUARD_MAP; 

: EXCEP_TRIGGER_MAP 
:= EMPTY_EXCEP_TRIGGER_MAP; 
: TIMER_OP_MAP 

EMPTY_TIMER_OP_MAP; 

: TIMING_MAP 

:= EMPTY_TIMING_MAP; 

: TEXT:= EMPTY TEXT) 
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begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT AN OPERATOR; 



end if; 

CO.G := PSDL GRAPH PKG.ADD VERTEX (OP NAME, CO.G, MET) / 



end ADD_VERTEX; 






procedure ADD EDGE(X, Y 


: in 


PSDL_ID; 


STREAM 


: in 


PSDL_ID; 


CO 


: in 


out COMPOS ITE_OPERATOR; 


LATENCY 


: in 


MILLISEC := 0) is 



begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

CO.G := PSDL_GRAPH_PKG.ADD_EDGE (X, Y, STREAT^, CO.G, LATENCY) 
end ADD_EDGE; 



procedure ADD_STREAM(S : in PSDL_ID; 

T : in TYPE_NAME; 

CO : in out COMPOS ITE_OPERATOR) is 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

TYPE_DECLARATION_PKG.BIND (S, T, CO.STR) ; 
end ADD STREAM; 



procedure ADD_TIMER(T : in PSDL_ID; 

CO : in out COMPOSITE OPERATOR) is 



begin 

if CO. CATEGORY /= PSDL OPERATOR then 



167 



raise NOT_AN_OPERATOR; 
end if; 

ID_SET_PKG. ADD (T, CO. TIM) ; 
end ADD TIMER; 



procedure SET_TRIGGER_TYPE (OP_ID ; in PSDL_ID; 

T : in TRIGGER_TYPE; 

CO ; in out COMPOS ITE_OPERATOR) is 

T_RECORD : TRIGGER_RECORD; 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

T_RECORD.TT := T; 

T_RE CORD . STREAMS ;= EMPTY_ID_SET; 

TRIGGER_MAP_PKG.BIND (OP_ID, T_RECORD, CO. TRIG); 
end SET TRIGGER TYPE; 



procedure 



SET_EXECUTION_GUARD (OP_ID 

E 

CO 



in PSDL_ID; 
in EXPRESSION; 

in out COMPOSITE OPERATOR) is 



begin 

if CO. CATEGORY /= PSDL_OPEPATOR then 
raise NOT_AN_OPERATOR; 
end if; 

EXEC_GUARD_MAP_PKG.BIND (OP_ID, E, CO. EG); 
end SET_EXECUTION GUARD; 



procedure SET_OUTPUT_GUARD (OP_ID : in PSDL_ID; 

STREAM : in PSDL_ID; 

E : in EXPRESSION; 
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CO : in out COMPOSITE_OPERATOR) is 

TEMP_ID ; OUTPUT_ID; 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

TEMP_ID.OP := OP_ID; 

TEMP_ID . STREAM := STREAM; 

OUT_GUARD_MAP_PKG.BIND (TEMP_ID, E, CO.OG); 
end SET OUTPUT GUARD; 



procedure SET_EXCEPTION_TRIGGER (OP_ID 


in 


PSDL_ID; 


EXCEP 


in 


PSDL_ID; 


E 


in 


EXPRESSION; 


CO 


in 


out COMPOSITE OPERATOR) is 



TEMP_ID : EXCEP_ID; 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

TEMP_ID.OP := OP_ID; 

TEMP_ID.EXCEP := EXCEP ; 

EXCEP_TRIGGER_MAP_PKG.BIND(TEMP_ID, E, CO.ET); 
end SET_EXCEPTION TRIGGER; 



procedure ADD_TIMER_OP (OP_ID, 

TIMER_ID 

TOP 

E 

CO 

TEMP_ID : TIMER_OP; 

TEMP_SET : TIMER_OP_SET; 
begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

TEMP_ID.OP_ID := TOP; 
TEMP_ID.TIMER_ID := TIMER ID; 



in PSDL_ID; 
in TIMER_OP_ID; 
in EXPRESSION; 

in out COMPOSITE OPERATOR) is 
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TEMP_ID . GUARD := E; 

TIMER_OP_SET_PKG. EMPTY (TEMP_SET) ; 

TIMER_OP_SET_PKG. ADD (TEMP_ID, TEMP_SET) ; 
TIMER_OP_MAP_PKG.BIND (OP_ID, TEMP_SET, CO.TIM_OP) ; 
end ADD TIMER OP; 



procedure SET_PERIOD (OP_ID 

P 

CO 

— Raises period_redef ined if 

— Raises period_redef ined if 



in PSDL_ID; 
in MILLISEC; 

in out COMPOS ITE_OPERATOR) is 
the period is non-zero. 

the period is non-zero. 



begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

if (TIMING_MAP_PKG. FETCH (CO. PER, OP_ID) ) /= 0 then 

raise PERIOD_REDEFINED; 
end if; 

TIMING_MAP_PKG.BIND (OP_ID, P, CO. PER) ; 
end SET_PERIOD; 



procedure SET_FINISH_WITHIN (OP_ID : in PSDL_ID; 

FW : in MILLISEC; 

CO : in out COMPOS I TE_OPERATOR) is 

— Raises f inish_within_redef ined if 

— the f inish_within is non-zero. 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

if (TIMING_MAP_PKG. FETCH (CO. FW, OP_ID) ) /= 0 then 
raise FINISH_WITHIN_REDEFINED; 
end if; 

TIMING_MAP_PKG.BIND (OP_ID, FW, CO.FW) ; 
end SET_FINISH WITHIN; 



procedure SET_MINIMUM_CALLING_PERIOD 

(OP ID : in PSDL ID; 
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MCP : in MILLISEC; 

CO : in out COMPOS ITE_OPERATOR) is 

— Raises minimum_calling_period_redef ined if the 

— minimum_calling_period is non-zero. 



begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end i f ; 

if (TIMING_MAP_PKG. FETCH (CO. MCP, OP_ID) ) /= 0 then 

raise MINIMUM_CALLING_PERIOD_REDEFINED; 
end if; 

TIMING_MAP_PKG.BIND (OP_ID, MCP, CO. MCP); 
end SET MINIMUM CALLING PERIOD; 



procedure SET_MAXIMUM_RESPONSE_TIME 

(OP_ID : in PSDL_ID; 

MRT : in MILLISEC; 

CO ; in out COMPOSITE OPERATOR) is 



-- Raises maximura_response_time_redef ined if the 
— maximum_response_time is non-zero. 

begin 

if CO. CATEGORY /= PSDL_OPERATOR then 
raise NOT_AN_OPERATOR; 
end if; 

if (TIMING_MAP_PKG. FETCH (CO. MRT, OP_ID) ) /= 0 then 

raise MAXII'«JM_RESPONSE_TIME_REDEFINED; 
end if; 

TIMING_MAP_PKG.BIND (OP_ID, MRT, CO. MRT); 
end SET_MAXI1HUM_RESP0NSE TIME; 






— Operations on all psdl types. 

function MODEL (T : DATA_TYPE) 

return TYPE_DECLARATION is 

— Returns the conceptual representation declared 

— in the specification part, 

— empty if not given. 

begin 
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case T. CATEGORY is 

when PSDL_OPERATOR -> 
raise NOT_A_TYPE; 
when PSDL_TYPE => 
return T.MDL; 
end case; 
end MODEL; 

function OPERATIONS (T : DATA_TYPE) 
return OPERATION_MAP is 

— Returns an environment binding operation 

— names to operation definitions, 

— an empty map if the type does not define any operations, 
begin 

case T. CATEGORY is 

when PSDL_OPERATOR => 
raise NOT_A_TYPE; 
when PSDL_TYPE => 
return T.OPS; 
end case; 
end OPERATIONS; 



— Operations on composite psdl data types. 

function DATA_STRUCTURE (T : COMPOS I TE_TYPE ) return TYPE_NAME is 

— Returns the data structure declared in the 

— psdl implementation part, 

— raises no_data_structure if the type is implemented in Ada. 



begin 

case T. CATEGORY is 

when PSDL_OPERATOR => 
raise NOT_A_TYPE; 
when PSDL__TYPE => 

case T. GRANULARITY is 
when ATOMIC => 

raise NO__DATA_STRUCTURE; 
when COMPOSITE => 
return T.DATA_STR; 
end case; 
end case; 



172 



end DATA STRUCTURE; 



function MAKE COMPOSITE TYPE 



(NAME 

MODEL 

DATA_STRUCTURE 
OPERATIONS 
GEN PAR 



PSDL_ID; 

TYPE_DECLARATION; 

TYPE_NAME; 

OPERATION_MAP; 
TYPE_DECLARATION 
:= EMPTY_TYPE_DECLAPJVTION 
ID_SET := EMPTY_ID_SET; 



KEYWORDS 

INFORMAL_DESCRIPTION 

AXIOMS 



: TEXT := EMPTY TEXT) 



return COMPOS ITE_TYPE is 
— Create a new composite type. 

X : COMPOS ITE_TYPE; 

begin 

X.NAME := NAME; 

X.GEN_PAR := GEN_PAR; 

X.KEYW := KEYWORDS; 

X.INF_DESC := INFORMAL_DESCRIPTION; 
X.AX := AXIOMS; 

X.OPS := OPERATIONS; 

X.MDL := MODEL; 

X.DATA_STR := DATA_STRUCTURE; 

return 



X; 
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stub 5/17/91 



end MAKE_COMPOSITE_TYPE; 

— outputs the psdl program 

procedure PUT_PSDL (P: IN PSDL_PROGRAM) is separate; 



r'k'k'k-k-lrif-k-k'k'k-k'k'k-y'k'k'k'k-k-k'k'k'k-k-k'k'k'k'k'k'k-k'k-k'k-k'tr'k'k'k-k'k'i 

FO R_RE F E RE N CE_ON L Y 

r + -*- + -*-*'*- + Tlr*Tlr + *-*- + -*- + + ** + '*-**+ + *-*- + + **- + ** + *'*-* + -**-*--^ 






private 

type psdl_component (category : component_type := psdl_operator; 

granularity: implement a tion_type composite) is 



★ 


record 




★ 


name: psdl_id; 




★ 


gen_par : type_declaration; 




★ 


keyw: id_set; 




★ 


inf_desc^ ax: text; 




★ 


case category is 




★ 


when psdl_operator => 




★ 


input, output, state: 


type_( 


★ 


init : init map; 




★ 


excep: id_set; 




★ 


smet : millisec; 




★ 


case granularity is 




★ 


when atomic => o ada 


name 


★ 


when composite => 




★ 


g: psdl_graph; 




★ 


str : type_declaration; 


+ 


tim: id_set; 




★ 


trig: trigger_map; 




★ 


eg: exec_guard_map 


} 


★ 


og : out_gua rd_map ; 




★ 


et : excep trigger map; 




★ 


tim_op: timer op map; 


+ 


per, fw, mcp, mrt, 


rmet 


★ 


end case; 




★ 


when psdl type => 






mdl : type_declaration; 




★ 


ops: operation_map; 






case granularity is 




★ 


when atomic => t ada 


name 


■*' 


when composite => data st: 


+ 


end case; 
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+ *** + -*->-★ 



*r -ir -k 






+ ★ ★ -ik- + + *- 



— * end case; 

— end record; 

^ ^ ~k ii -k -k -k k k-k-k-k-kkkkkkk-kk-k k 

end PSDL COMPONENT PKG; 
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APPENDIX H. IMPLEMENTATION OF PUT OPERATION 



— psdl_put.a 



Unit name 
File name 
Author 

Date Created 
Address 
Last Update 



Output operation for PSDL ADT 
psdl_put .a 
Suleyman BAyramoglu 
December 1990 

bayram0taurus . cs .nps .navy.mil 
{Tue Sep 24 01:14:17 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : abstract data type, PSDL program 

— Abstract : 

This package is the implementation for the PSDL ADT 
Revision history 

— $Source: /n/gemini/work/bayram/AYACC/parser/RCS/psdl_put . a, v $ 
— $Revision: 1.16 $ 

— $Date: 1991/09/24 08:29:03 $ 

— $Author: bayram $ 



separate (Psdl_Component_Pkg) 



procedure PUT_PSDL 

— Extract the text representation of PSDL program from 

— the PSDL ADT and outputs as a legal PSDL source file 

— The output is always to standard output, but command line 

— switch when invoking the expander, directs renames the 

-- renames the standard output to as the given UNIX file — 

-- A modification can be done to this procedure in package 
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— Psdl_Component_Pkg, (separate procedure put_psdl) 

-- to use a file instead of standard output for flexibity 

— The best thing to provide tv/o procedures one for stdout 

— the other for file out, and it is fairly eeasy to do. 



procedure Put_Psdl (P: in Psdl_Program) is 

Cp : Component_Pt r ; 

C : Psdl_Component ; 

0 : Operator; 

T : Data_Type; 

A : Atomic__Component ; 

Ao : Atomic_Operator ; 

Co : Composite_Operator; 

Ct : Composite_Type; 



function Size_Of(S: Psdl_Program_Pkg . Res_Set ) return NATUPvAL 
renames Psdl_Program_Pkg . Res_Set_Pkg . Size; 

function Size_Of(S: Id_Set) return NATURAL 
renames Id_Set_Pkg . Size; 



-- function fetch__id(s: id_set; n: natural) return psdl_id 
renames id_set_pkg . fetch; 



Pp_Domain_Set : Psdl_Program_Pkg . Key_Set ; 

Pp_Range_Set : Psdl_Program_Pkg . Res_Set ; 

Htab : constant STRING := ” -- horizantal tabulation 



— print component category and name of the component 
procedure Put_Component_Name (C : in Psdl_Component ) is 

begin 

if Component_Category (C) = Psdl_Operator then 
Put (’’OPERATOR "); 
else 
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Put (’’TYPE ”); 
end if; 

Put_Line (C.Name.S) ; 
end Put_Component_Name; 



procedure Put_Id_List (Id_List : in Id_Set; 

Message : in String) is 

I : NATURAL := 1; 
begin 

if not Id_Set_Pkg . Equal ( Id_List, Empty_Id_Set ) then 
Put_Line (Htab & Htab & Message); 

Put(Htab & Htab & Htab); 

— Begin expansion of FOREACH loop macro, 
declare 

procedure Loop_Body(Id : Psdl_Id) is 
begin 

if I > 1 then 

Put (”,”); 
end if; 

Put (Id. S) ; 

I ;= I + 1; 

end Loop_Body; 

procedure Execute_Loop is new Id_Set_Pkg . Generic_Scan (Loop_Body ) ; 
begin 

Execute_Loop ( Id_List ) ; 
end; 

— LIMITATIONS: Square brackets are used as macro 
— quoting characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the 

— lower case spellings of 

— the identifier names ’’DEFINE”, ’’UNDEFINE’’, and "DNL”, 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

-- End expansion of FOREACH loop macro. 

New Line (2 ) ; 
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end if; 



end Put Id List; 



procedure Put_Id_List (Id_List : in Id_Set) is 

I : NATURAL := 1; 
begin 

if not Id_Set_Pkg . Equal ( Id_List, Empty_Id_Set ) then 
— Begin expansion of FOREACH loop macro, 
declare 

procedure Loop_Body(Id : Psdl_Id) is 
begin 

if I > 1 then 

Put ”) ; 
end if; 

Put (Id.S) ; 

I := I + 1; 

end Loop_Body; 
procedure Execute_Loop is 

new Id_Set_Pkg.Generic_Scan (Loop_Body) ; 

begin 

Execute_Loop ( Id_List ) ; 
end; 
end if; 

end Put Id_List; 



procedure Put_Smet (0 : in Operator) is 
begin 

if O.Smet > 0 then 

Put(Htab & Htab i "MAXIMUM EXECUTION TIME "); 
Put_Line ( INTEGER ’ Image (0 . Smet ) & " ms")/ 
New_Line; 
end if; 
end Put_Smet; 



— output Inf ormal_Descript ion, Formal_Descript ion 
procedure Put_Text(T : in Text; Message : in String) is 
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begin 

if not A_Strings . Is__Null (A_Strings . A__String (T) ) 
and T /= Empty__Text then 
Put (Htab & Htab & Message & ” "); 

Put_Line (T. S) ; 

New_Line; 
end if; 
end Put Text; 



— Output the Type Name in a recursive manner 
procedure Put_Type__Name (Tname : in Type_Name) is 

i : Natural := 1; 
begin 

Put (Tname . name . s ) ; 

if not Type_Declaration_Pkg . Equal (Empty_Type__Declaration, 

Tname . Gen_Par) then 

Put ("["); 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body (id : in Psdl_Id; Tn : in Type_Name) is 
begin 

if i > 1 then 
Putr, ”); 
end if; 

Put (Id.s & " : "); 

Put_Type_Name (Tn) ; — print out the rest 

i : = i + 1 ; 

end loop_body; 
procedure execute_loop is 

new Type__Declaration__Pkg.Generic__Scan (loop__body) ; 

begin 

execute_loop (Tname . Gen_par) ; 
end; 

— LIMITATIONS: Square brackets are used as macro 
— quoting characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the 

— lower case spellings of 

— the identifier names ’’DEFINE", "UNDEFINE" , and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 
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— a separate call to m4 ; put each package in a separate file, 

— Exit and return statements inside the body of a FOREACH loop 
-- may not work correctly if FOREACH loops are nested. 

-- An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro. 

Put (”] ”) / 
end if; 

end Put_Type_Name; 



procedure Put_Type_Decl (Td : in Type_Declarat ion; 

Message: in String:^ " ") is 

i : natural := 1; 
begin 

if not Type_Declarat ion_Pkg . Equal (Empty_Type_Declarat ion, Td) then 
put_line (htab & htab & Message); 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body (id : in Psdl_Id; Tn : in Type_Name) is 
begin 

if i > 1 then 

Put ( ” , ” & Ascii .If) ; 
end if; 

Put (Htab & Htab & Htab & Id.S & Ascii. HT & ” : ” ); 

Put_Type_Name (Tn) ; 
i := i -f* 1; 

end loop_body; 
procedure execute_loop is 

new Type_Declaration_Pkg . Generic_Scan ( loop_body ) ; 

begin 

execute_loop (Td) ; 
end; 

New_Line (2 ) ; 
end if; 

end Put_Type_Decl ; 
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procedure Put_State ( State : in Type_Declaration; 

Init : in Init_Map) Is 
i, j : Natural := 1; 

Prev_Tn : Type_Name:= null; 

Begin 

if not Type_Declaration_Pkg.Equal (Empty_Type_Declaration, State) then 
Put_Line (Htab & Htab i ’’STATES”); 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body ( Id : In Psdl_Id; Tn : Type__Name) is 
begin 

if i > 1 then 

if Prev_Tn = Tn then 
put(”,” & Ascii. Lf); 
else 

put(” : ”); 

Put_Type_NAme (Prev_Tn) ; 

Put_Line (",”); 
end if; 
end if; 

put (Htab & Htab & Htab & Id.S); 

Prev_Tn := Tn; 
i : = i + 1 ; 

end loop_body; 
procedure execute_loop is 

new Type_Declaration_Pkg.Generic_Scan (loop_body) ; 

begin 

execute_loop (State) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting 

— characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower 

— case spellings of 

— the identifier names ’’DEFINE”, ’’UNDEFINE”, and ”DNL”, 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro. 

Put(” : ”); 
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Put_Type_Name (Prev_Tn) ; 
put(" INITIALLY '•); 

Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body ( Id : In Psdl_Id/ E: Expression) is 
begin 

if j > 1 then 
Put(’\ ”); 
end if; 

Put (E.S) ; 
j := j + 1; 

end loop_body; 
procedure execute_loop is 

new Init_Map_Pkg . Generic_Scan ( loop_body ) ; 

begin 

execute_loop ( Init ) ; 
end; 

-- LIMITATIONS; Square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case 

— spellings of 

— the identifier names ’’DEFINE", "UNDEFINE", and ’’DNL’’, 

— or must quote them like this: [define]. 

— The implem.entation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

-- Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

-- An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro. 
new_line (2 ) ; 

end if; 

end Put State; 



— Output operator spec 



procedure Put_Operator_Spec (0 : in Operator) is 



begin 

Put_Line (Htab & "SPECIFICATION"); 
Put_Type_Decl (O.Gen_Par, "GENERIC") ; 
Put_Type_Decl (0. Input, "INPUT") ; 
Put_Type_Decl (0 . Output , "OUTPUT" ) ; 



— put generic parameters 

— put inputs 

— put outputs 
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Put_State (0 . state, O.Init); — put states 

Put_Id_List (0 . Excep, "EXCEPTIONS"); — put exceptions 

Put_Smet (0) ; — put specified MET 

put_reqmts_t race — not implemented in this version of ADT 

Put_Id_List (0 . Keyw, "KEYWORDS"); — put keywords 

Put_Text (0 . Inf_Desc, "DESCRIPTION"); — put inf. description 

Put_Text (0 . Ax, "AXIOMS"); — put formal description 

Put_Line (Htab Sc "END"); 
end Put_Operator_Spec; 



-- Output psdl type spec 



procedure Put_Type_Spec (T : in Data_Type) is 
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— Output operator spec for a psdl type 

— the only difference is the format, an elegant 

— way can be easily 

-- found to use the procedure Put_Operator_Spec by 

— setting a flag, but this is a quick and dirty fix. 



procedure Put_Op_Spec (0 : in Operator) is 



begin 

Put_Line (Htab & "SPECIFICATION”); 
Put_Type_Decl (0 . Gen_Par, "GENERIC"); -- put 

Put_Type_Decl (0 . Input , "INPUT"); — put 

Put_Type_Decl (0. Output , "OUTPUT"); — put 

Put_State (0 . State, O.Init); -- put 

Put_Id_List (O.Excep, "EXCEPTIONS"); — put 

Put_Smet (0) ; — put 

put_reqmts_trace — not implemented in 

Put_Id_List (O.Keyw, "KEYWORDS"); — put 

Put_Text (0. Inf_Desc, "DESCRIPTION"); — put 

— put formal description 

Put_Line (Htab & "END"); 
end Put_Op_Spec; 



generic parameters 

inputs 

outputs 

states 

exceptions 

specified MET 

this version of ADT 

keywords 

inf. description 



procedure Put_Op_Spec_List (Op_Map : in Operat ion_Map) is 
begin 
declare 

procedure Loop_Body(Id : in Psdl_Id; Op : in Op_Ptr) is 
begin 

0 := Op. all; 

Put (Htab) ; — indent a little bit 

Put_Component_Name (0) ; 

Put_Op_Spec (0) ; 

New_Line; 

end Loop_Body; 
procedure Execute_Loop is 

new Operation_Map_Pkg . Generic_Scan (Loop_Body) ; 

begin 

Execute_Loop (Operation_Map_Pkg .Map (Op_MAp) ) ; 
end; 

end Put_Op_Spec_List ; 
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begin — Put_Type_Spec 



Put_Line ( "SPECIFICATION" ) ; 
Put_Type_Decl (T.Gen_Par, "GENERIC") ; 


— put 


generic parameters 


Put_Type_Decl (T.Mdl) ; 


— Put 


Model 


Put_Op_Spec_List (T.Ops) ; 
Put_Id_List (O.Keyw, "KEYWORDS") ; 


— put 


keywords 


Put_Text (O.Inf_Desc, "DESCRIPTION") ; 


— put 


inf. description 


Put_Text (O.Ax, "AXIOMS"); 


— put 


formal description 


Put_Line("END") ; 
New Line; 

end Put_Type_Spec; 







— Output operator implementation 
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procedure Put_Operator_Implementation (0 : in Operator) is 
Co : Composite_Operator ; 



— output the graph 



procedure Put__Graph (G : in Psdl_Graph) is 



— output the vertices 



procedure Put_Vertices (G: in Psdl_Graph) is 
Vertex_List : Id_Set; 

Met : Millisec; 

begin 

Id_Set_Pkg . Assign (Vertex_List , P sdl_Graph_P kg . Vert ices (G) ) ; 

— /^foreach ( [Id : Psdl_Id] , [Id_Set_Pkg . Generic_Scan] , 

[Vertex_List ] , 

— /* [ 

Put(Htab & Htab & Htab & "VERTEX " & Id.s); 

— /* Met := Psdl_Graph_Pkg .Maximum_Execut ion_Time ( Id, G) ; 

if Met /= 0 then 

--/* Put_Line(" : " & Integer ’ Image (Met ) & " ms"); 

— /* else 

— New__Line; 

— /■* end if; 

— r ]) 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(Id : Psdl_Id) is 
begin 

Put (Htab & Htab & Htab & "VERTEX " & Id.s); 

Met := Psdl_Graph_Pkg .Maximum_Execution_Time ( Id, G) ; 
if Met /= 0 then 

Put_Line(" : " & Integer ' Image (Met ) & " ms"); 
else 

New_Line; 
end if; 

end loop_body; 
procedure execute_loop is 
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new Id_Set_Pkg.Generic_Scan (loop_body) ; 
begin 

execute_loop (Vertex_List ) ; 
end; 

New_Line; 
end Put Vertices; 



— output the edges 



procedure Put_Edges (G: in Psdl_Graph) is 
Edge_List : Edge_Set; 

Latency_t ime : Millisec; 

begin 

Edge_Set_Pkg .Assign (Edge_List, Psdl_Graph_Pkg . Edges (G) ) ; 

— f oreach ( [E : EDGE], 

— /* [Edge_Set_Pkg . Generic_Scan] , 

— /'^ [Edge_List], 

— /* [ 

— /* Put(Htab & Htab & Htab & "EDGE " & 

— /■*■ E . Stream_Name . s & " ") ; 

— /* Latency_Time : = 

— Psdl_Graph_pkg . Latency (E . X, E . Y, E . Stream_Name, G) ; 

— /■*■ if Latency_Time /= 0 then 

— /'^ Put(": " & Integer ’ Image (Latency_Time) &” ms "); 

— /•*■ end if; 

— /■*■ Put_Line (E.X.s & " -> E.Y.s); 

— /* ]) 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(E : EDGE) is 
begin 

Put (Htab & Htab & Htab & "EDGE " & E . Stream_Name . s &" "); 
Latency_Time := 

Psdl_Graph_pkg . Latency (E . X, E.Y, E . Stream_Name, G) ; 
if Latency_Time /= 0 then 

Put(": " & Integer ’ Image (Latency_Time) & " ms " ); 
end if; 

Put_Line (E.X.s & " -> " & E.Y.s); 
end loop_body; 

procedure execute_loop is 

new Edge_Set_Pkg. Generic_Scan (loop_body) ; 
begin 
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execute_loop (Edge_List) ; 
end; 

New_Line; 
end Put_Edges; 



begin -- Put_Graph 
New_Line; 

Put_Line (Htab & Htab & "GP>APH"); 
Put_Vertices (G) ; 

Put_Edges (G) ; 
end Put_Graph; 



— output the control constraints 



procedure Put_Control_Constraints (Co : in Composite_Operator ) is 
The_Op_Id_Set : Id_Set := Empty__Id_Set ; 

Local_Id : Psdl__Id; — to get around Verdix bug 

function Vertices (G: PSdl_Graph) return Id_Set 
renames Psdl_Graph_Pkg .Vertices; 

--package Tt_Io is new Enumeration_Io (TRIGGER_TYPE) ; 
package Tim_Op_Io is new Enumeration_Io (TIMER_OP_ID) ; 



-- output trigger map 



procedure Put_Triggers (0_Name : Psdl_Id; 

T_Map : Trigger_Map) is 

The_Trigger_Rec : Trigger_Record; 

begin 

/* Put the triggers for each operator if they exist */ 
if Trigger_Map_Pkg .Member (0_name, T_Kap) then 
Put (Htab S. Htab & Htab & ” TRIGGERED "); 
The_Trigger_Rec := Trigger_Map_Pkg . Fetch (T_Map, 0_name) ; 
if The_Trigger_Rec . TT = BY_ALL then 
Put (” BY ALL ”) ; 
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Put_Id_List (The_Trigger_Rec. Streams) ; 
elsif The_Trigger_Rec . TT = BY_SOME then 
PutC’ BY SOME ”); 

Put_Id_List (The_Trigger_Rec . Streams) ; — if none 

— then do nothing 

end if; 

if not Exec_Guard_Map_Pkg .Member (0_name, O.Eg) then 
Put (Ascii . Lf ) ; 
end if; 
end if; 

end Put_Triggers ; 



-- output execution guard for each trigger if exists 



procedure Put_Exec_Guard (0_Name : Psdl_Id; 

Eg_Map ; Exec_Guard_Map) is 

The_Exec_Guard_Expr : Expression; 

begin 

if Exec_Guard_Map_Pkg .Member (0_name, Eg_Map) then 
The_Exec_Guard_Expr := 

Exec_Guard_Map_Pkg . Fetch (Eg_Map, 0_name) ; 
Put_Line(" IF ” i The_Exec_Guard_Expr . s) ; 
end if; 

end Put_Exec_Guard; 



-- output timings for each operator if exists 



procedure Put_Timing (Key : in Psdl_Id; 

Tim_Map : in Timing_Map; 

Timing_Message : in String) is 

Time_Val : Millisec : =0; 

begin 

-- Check if timing exists for each operator 
-- if exists print them out. 
if Timing_Map_Pkg .Member (Key, Tim_Map) then 

Time_Val Timing_Map_Pkg . Fetch (Tim_Map, Key) ; 
Put (Htab & Htab & Htab s " " s Timing_Message) ; 
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Put_Line ( integer ' image (Time_Val) & " ms"); 
end if; 

end Put_Timing; 



— output out guard for each trigger if exists 



procedure Put_Output_Guard (0_Name : Psdl_Id; 

Og_Map : Out_Guard_Map) is 

begin 

— m4 macro code 

— f oreach ( [0_ld : Output_Id; E: Expression], 
[Out_Guard_Map_Pkg . Generic_Scan ] , 

[Og_Map], 

[ 

if Eq(0_Name, 0_ld.0p) then 
Put (Htab & Htab & Htab) ; 

Put(" OUTPUT "); 

Put (0_ld . Stream. s ); 

Put_Line(" IF " & E.s); 
end if; 

] ) 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body (0__ld : Output_Id; E: Expression) is 
begin 

if Eq(0_Name, 0_ld.0p) then 
Put (Htab & Htab & Htab) ; 

Put(" OUTPUT "); 

Put (0_ld . Stream. s ) ; 

Put_Line(" IF " & E.s); 
end if; 

end loop_body; 
procedure execute_loop is 

new Out_Guard__Map_Pkg . Generic_Scan ( loop_body ) ; 

begin 

execute_loop (Og_Map) ; 
end; 

end Put_Output_Guard; 



— output timer op for each operator if exists 
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procedure Put_Timer_Op (0_Name ; Psdl_Id; 

T_Op_Map : Timer_Op_Map) is 

— The_Timer_Op_Rec : Timer_Op; 

The_Timer_Op_List : Timer_Op_Set ; 

begin 

-- /* Check if timer op exists for each operator */ 

if Time r_Op_Map_Pkg .Member (0_name, T_Op_Map) then 
Th e_T ime r_Op_L i s t : = 

Timer_Op_Map_Pkg . Fetch (T_Op_Map, 0_name) ; 

— foreach( [The_Timer_Op_Rec : Timer_Op] , 

[Timer_Op_Set_Pkg . Generic_Scan] , 
[The_Timer_Op_List ] , 

[ 

Put (Htab & Htab & Htab & ” ”); 

Tim_Op_Io.Put (The_Timer_Op_Rec .Op_Id) ; 

Put(” TIMER "); 

Put (The_Timer_Op_Rec . Timer_Id . s ) ; 

Put_Line(” IF " & The_Timer_Op_Rec . Guard . s ) ; 

]) 



— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body (The_Timer_Op_Rec : Timer_Op) is 
begin 

Put (Htab & Htab & Htab & " ”) ; 

Tim_Op_Io . Put (The_Timer_Op_Rec . Op_Id) ; 

Put(” TIMER ”); 

Put ( The__T ime r_Op_Re c . Timer _Id . s ) / 

Put_Line(” IF ” & The_Timer_Op_Rec.Guard.s) ; 

end loop_body; 
procedure execute_loop is 

new Timer_Op_Set_Pkg . Generic_Scan ( loop_body ) ; 

begin 

execute_loop (The_Timer_Op_List ) ; 
end; 

end if; 

end Put_Timer_Op; 
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-- output exception triggers for each operator if exists 



procedure Put_Excep_Trigger (0_Name : Psdl_Id; 

Et_Map : Excep_Trigger_Map) is 



begin 

--f oreach ( [E_Id : Excep_Id/ E: Expression], 

[Excep_Trigger_Map_Pkg . Generic_Scan] , 

[Et_Map], 

[ 

if Eq(0_name, E_Id.Op) then 
Put (Htab & Htab & Htab) ; 

Put r EXCEPTION ”); 

Put (E_Id.Excep.s ); 

Put_Line (" IF " S. E.s) ; 
end if; 

] ) 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body (E_Id : Excep_Id; E: Expression) is 
begin 

if Eq(0_name, E_Id.Op) then 
Put (Htab & Htab & Htab) / 

Putr EXCEPTION "); 

Put (E_Id . Excep , s ); 

Put_Line (” IF ” & E.s) ; 
end if; 

end loop_body; 

procedure execute_loop is 

new Excep_Trigger_Map_Pkg . Generic_Scan (loop_body ) ; 

begin 

execute_loop (Et_Kap) ; 
end; 

end Put_Excep_Trigger; 



begin — Put_Control_Constraints 

Id_Set_Pkg . Assign (The_Op_Id_Set , Vertices (Co.G) ) ; 
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Put_Line (Htab & Htab & ’’CONTROL CONSTRAINTS”)/ 

— foreach ( [Id ; Psdl_Id] , [ Id_Set_Pkg . Generic_Scan] , 

[The_Op_Id_Set ] , 

[ 

Local_Id := Id; 

Put_Line (Htab & Htab & Htab & ’’OPERATOR ” &Local_Id . s ) ; 
Put_Triggers (Local_Id/ Co. Trig); 

Put_Exec_Guard (Local_Id, Co. Eg, / 

— /* Put the timings if exist / 

Put_Timing(Local_Id, Co. Per, ’’PERIOD ”); 
Put_Timing(Local_Id, Co.Fw, ’’FINISH WITHIN ”); 
Put_Timing(Local_Id, Co .Mcp, "MINIMUM CALLING PERIOD ”) ; 
Put_Timing(Local_Id, Co .Mrt, "MAXIMUM RESPONSE TIME ’’) ; 
Put_Output_Guard (Local_Id, Co.Og); 

Put_Timer_Op (Local_Id, Co.Tim_Op); 

Put_Excep_Trigger (Local_Id, Co .Et) / 

New_Line; 

] ) 



-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(Id : Psdl_Id) is 
begin 

Local_Id := Id; 

Put_Line (Htab & Htab & Htab & "OPERATOR ’’ & Local_Id.s); 
Put__Triggers (Local_Id, Co. Trig); 

Put_Exec_Guard (Local_Id, Co. Eg) ; 

— /* Put the timings if exist */ 

Put_Timing (Local_Id, Co. Per, "PERIOD ’’) ; 

Put_Timing (Local_Id, Co.Fw, "FINISH WITHIN ’’); 
Put_Timing (Local_Id, Co. Mcp, "MINIMUM CALLING PERIOD "); 
Put_Timing(Local_Id, Co. Mrt, "MAXIMUM RESPONSE TIME ") ; 
Put_Output_Guard (Local_Id, Co.Og) ; 

Put_Timer_Op (Local_Id, Co.Tim_Op) ; 

Put_Excep_Trigger (Local_Id, Co.Et) ; 

New Line; 



end loop_body; 
procedure execute_loop is 

new Id_Set_Pkg. Generic_Scan (loop_body) ; 

begin 

execute_loop (The_Op_Id_Set ) ; 
end; 

— LIMITATIONS: Square brackets are used as 

— macro quoting characters, 

-- so you must write [ [x] ] in the m4 source file 
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to get [x] in the generated Ada code. 

Ada programs using FOREACH loops must avoid the lov/er case 
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spellings of 

-- the identifier names "DEFINE”, "UNDEFINE”, and "DNL", 

— or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 
— Exit and return statements inside the body of a FOREACH loop 
-- may not work correctly if FOREACH loops are nested. 

-- An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOP.EACH loop macro. 

end Put Control Constraints; 



begin 

Put(Htab & "IMPLEMENTATION "); 
if Component_Granularity (0) = Composite then 
Co := 0; 

Put_Graph (CO.G) ; — put graph 

Put_Type_Decl (Co . Str , "DATA STREAM"); — put data streams 
Put_Id_List (Co. Tim, "TIMERS"); — put timers 

Put_Control_Constraints (Co) ; — put control constraints 

Put_Text (Co . Impl_Desc, "DESCPvIPTION" ) ; — put inf. description 
else 

Put_Line ( "ADA " L 0 . 0_Ada_Name . S) ; — put ada_name 

end if; 

Put_Line (Htab 6. "END"); 

New_Line; 

end Put_Operator_Implementation; 



--Output psdl_type implementation 



procedure Put_Type_Implementation (T : in Data_Type) is 
0: Operator; 
begin 

Put ( " IMPLEMENTATION " ) ; 

if Component_Granularity (T) = Composite then 
Put_Type_Name (T . Data_Str ) ; 

New_Line; 

declare 

procedure Loop_Body(Id : in Psdl_Id; Op : in Op_Ptr) is 
begin 

0 := Op. all; 

Put_Line (Htab & "OPERATOR " & Id.s); 
Put_Operator_Implementation (0) ; 



1 % 



New_Line; 



end Loop_Body; 
procedure Execute_Loop is 

new Operat ion_Map_Pkg . Generic_Scan (Loop_Body ) ; 

begin 

Execute_Loop (Operation_Map_Pkg.Map (T.Ops) ) ; 
end; 
else 

Put_Line(" ADA " & T . T_Ada_Name . S) ; 
end if; 

Put_Line ( "END" ) ; 
end Put_Type_Implementation; 



begin 

declare 

procedure Loop_Body(Id : in Psdl_Id; Cp : in Component_Ptr ) is 
begin 

C : = Cp . a 1 1 ; 

Put_Component_Name fC) ; 

if Component_Category (C) = Psdl_Operator then 
C C; 

Put_Operator_Spec (0) ; 

Put_Operator_Implementat ion (0) ; 
else 

T := C/ 

Put_Type_Spec (T) ; 

Put_Type_Implementation (T) ; 
end if; 



end Loop_Body; 
procedure Execute_Loop is 

new Psdl_Program_Pkg . Generic_Scan (Loop_Body) ; 

begin 

Execute_Loop (Psdl_Program_Pkg .Map (P) ) ; 
end; end Put Psdl; 
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APPENDIX I. PACKAGE PSDL CONCRETE TYPES 



— psdl_cts.a 



Unit name 
File name 
Author 

Date Created 
Modified by 
Address 
Last Update 



Specification of package psdl concrete types 
psdl_cts .a 

Valdis Berzins (berzins0taurus.cs.nps.navy.mil) 

December 1990 

Suleyman BAyramoglu 

bayramOtaurus . cs . nps.navy.mil 

{Tue Sep 24 02:00:10 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4 , SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : abstract data types 

— Abstract : 

Provides the supporting types to PSDL ADT 

Revision history -■ 



--$Source : 

/n/gemini/work /bayram/AYACC/parser/psdl_ada . lib/RCS/psdl_cts . a, v $ 
— $Revision: 1.7 $ 

— $Date: 1991/09/24 09:08:47 $ 

--$Author: bayram $ 



— Modified {Fri Aug 30 17:27:59 1991 - bayram} 

— Provided function Eg for generic map and set instatiations . 

with A_Strings; 

— See verdix library ’’standard”, 
with Generic_Set_Pkg; 

— Defines a generic set data type, 
with Generic_Map_Pkg; 

— Defines a generic map data type. 
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package PSDL_CONCRETE_TYPE_PKG is 
subtype MILLISEC is NATURAL; 



type TEXT is 
type ADA_ID is 
type PSDL_ID is 
subtype VARIABLE is 
type EXPRESSION is 
Empty_Text : constant 



new A_Strings . A_String; 
new A_Strings . A_String; 
new A_St rings . A_String; 
PSDL_ID; 

new A_Strings . A_String; 

TEXT := TEXT (A_Strings. Empty) ; 



function Eq(x, y: Psdl_Id) return BOOLEAN; 



function Eq(x, y: Expression) return BOOLEAN; 



> PSDL_ID, 

> 48 , 

> Eq) ; 

subtype ID_SET is Id_Set_Pkg . Set ; 
function Empty_Id_Set return ID_SET; 

— Returns an empty set . 



package Id_Set_Pkg is 

new Generic_Set_Pkg (T = 

Block^Size = 
Eq 



package lnit_Map_Pkg is 

new Generic_Kap_Pkg (Key => PSDL_ID, 

Result => EXPRESSION, 
Eq_Key => Eq, 

Eq_Res => Eq) ; 



subtype INIT_MAP is Init_Map_Pkg .Map; 

function Empty_Init_Map return INIT_MAP; 
— Returns an empty init_map; 



package Exec_Guard_Map_Pkg is 

new Generic_Map_Pkg (Key => PSDL_ID, 

Result => EXPRESSION, 



Eq_Key => Eq, 
Eq_Res => Eq) ; 



subtype EXEC_GUARD_MAP is Exec_Guard_Map_Pkg .Map ; 

function Emipty_Exec__Guard_Map return EXEC_GUARD_MAP; 
— Returns an empty exec_guard_map; 

type OUTPUT_ID is 
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record 

Op, Stream : PSDL_ID; 
end record; 



function Eq(X, Y: Output_Id) return Boolean; 



package Out_Guard_Map_Pkg is 

new Generic_Map_Pkg (Key => 

Result => 
Eq__Key => 
Eq_Res => 



OUTPUT_ID, 

EXPRESSION, 

Eq, 

Eq) / 



subtype OUT_GUARD_MAP is Out_Guard_Map_Pkg .Map; 

function Empty_Out_Guard_Map return OUT_GUARD_MAP ; 
— Returns an empty out_guard_map; 



type EXCEP_ID is 
record 

Op, Excep : PSDL_ID; 
end record; 



function Eq(X, Y: Excep_ld) return Boolean; 

package Excep_Trigger_Map_Pkg is 

new Generic_Map_Pkg (Key => EXCEP_ID, 

Result => EXPRESSION, 

Eq_Key => Eq, 

Eq_Res => Eq) ; 

subtype Excep_Trigger_Map is Excep_Trigger_Map_Pkg .Map; 
function Empty_Excep_Trigger_Map return Excep_Trigger_Map; 
— Returns an empty excep_trigger_map; 

type TRIGGER_TYPE is (BY_ALL, BY_SOME, NONE) ; 

type TRIGGER_RECORD is 
record 

Tt : TRIGGER_TYPE; 

Streams : ID_SET; 
end record; 



package Trigger_Map_Pkg is new 
Generic_Map_Pkg (Key => 
Result => 
Eq_Key => 



PSDL_ID, 
TRIGGER_RECORD, 
Eq) ; 
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subtype TRIGGER_MAP is Trigger_Map_Pkg .Map; 

function Empty_Trigger_Map return TRIGGER_MAP; 

— Returns an empty trigger_map; 

type TIMER_OP_ID is (START, STOP, RESET, NONE) ; 
type TIMER__OP is 
record 

Op_Id : TIKER_OP_ID; 

Timer_Id : PSDL_ID; 

Guard : EXPRESSION; 
end record; 

package Timer_Op_Set_Pkg is 

new Generic_Set_Pkg (T => TIMER_OP, Block_Size => 1) ; 
subtype Timer_Op_Set is Timer_Op_Set_Pkg . Set ; 
package Timer_Op_Map_Pkg is 

new Generic_Map_Pkg (Key => PSDL_ID, 

Result -> TIMER_OP_SET, 

Eq_Key => Eg) ; 

subtype Timer_Op_Map is Timer_Op_Map_Pkg .Map; 

function Empty_Timer_Op_Map return Timer_Op_Map; 

— Returns an empty t imer__op_map; 

package Timing_Map_Pkg is 

new Generic_Map_Pkg (Key => PSDL_ID, 

Result => MILLISEC, 

Eq_Key => Eq) ; 

subtype TIMING_MAP is Timing_Map_Pkg .Map; 

function Empty_Timing_Map return TIMING_MAP; 

— Returns an empty timing^map; 

type TYPE_NAME_RECORD; 

Forward declaration. 

type TYPE_NAME is access TYPE_NAME_RECORD; 

— The name of a psdl type, with optional generic parameters. 

package Type_Declaration_Pkg is 

new Generic_Map_Pkg (Key => PSDL_ID, 

Result => TYPE_NAME, 

Eq_Key => Eq) ; 
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subtype Type_Declarat ion is Type_Declaration_Pkg .Map; 

— A psdl type declaration is a map from psdl identifiers 

— to psdl type names. 

— The default value of a type declaration map is 
— the null pointer. 

type TYPE_NAME_RECORD is 
record 

Name : PSDL_ID; 

Gen_Par : Type_Declaration; 
end record; 

— The generic parameter map is empty if 

— the named type is not generic. 

function Empty_Type_Declaration return Type_Declaration; 

— Returns an empty type declaration map. 

end PSDL CONCRETE TYPE PKG; 



— psdl_ctb.a 



Unit name 
File name 
Author 

Date Created 
Modified by 
Address 
Last Update 



Implementation of package psdl concrete types 
psdl_ctb . a 

Valdis Berzins (berzins@taurus.cs.nps.navy.mil) 

December 1990 

Suleyman BAyramoglu 

bay ram@taurus . cs . nps . navy .mil 

{Tue Sep 24 02:00:10 1991 - bayram} 



-- Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : abstract data types 

— Abstract : 

Provides the supporting types to PSDL ADT 

Revision history 
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— $Source : 

/n/gemini/work/bayram/AYACC/parser /psdl_ada . lib/RCS/psdl_ctb . a, v 3 
--$Revision: 1.6 $ 

— $Date: 1991/09/24 09:09:01 $ 

— $Author: bayram $ 



— Revision 1.2 1991/08/24 00:36:00 bayram 

Modified to incorporate the new set and map packages 

package body Psdl_Concrete_Type_Pkg is 

use Id_Set_Pkg, Timer_Op_Set_Pkg; 
use lnit_Map_Pkg, Exec_Guard_Map_Pkg, 
use Out_Guard_Map_Pkg; 

use Excep_Trigger_Map_Pkg, Trigger_Map_Pkg; 
use Timer_Op_Map_Pkg, Timing_Kap_Pkg, 
use Type_Declaration_Pkg; 

Empty_Expression : constant Expression 

:= Expression (A_Strings .Empty) ; 

function Empty_Id_Set return Id_Set is 
S : Id_Set; 
begin 

Empty (S) / 
return S; 
end Empty_Id_Set ; 

Returns an empty set . 

— Overloaded functions for generic instantiations 

functio.n Eq(x, y: Psdl_Id) 
return BOOLEAN is 

begin 

return (X.S = Y.S) / 
end Eg; 



function Eq(x, y: Expression) 
return BOOLEAN is 

begin 

return (X.S = Y . S) ; 
end Eq; 
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function Eq(X, Y: Output_Id) 
return Boolean is 

begin 

return (Eq (X. Op, Y.Op) and Eq(X. Stream, Y. Stream))/ 
end Eq; 



function Eq(X, Y: Excep_Id) return Boolean is 
begin 

return (Eq (X . Op, Y.Op) and Eq(X.Excep, Y.Excep)); 
end Eq; 



function Empty_Init_Map return Init_Map is 
M : Init_Map; 
begin 

Create (Empty_Expression, M) / 
return M; 

end Empty_Init_Map; 

-- Returns an empty init_map; 



function Empty_Exec_Guard_Map 

return Exec_Guard_Map is 
M : Exec_Guard_Map; 
begin 

Create (Empty_Expression, M) ; 
return M; 

end Empty_Exec_Guard_Map; 

— Returns an empty exec_guard_map; 



function Empty_Out_Guard_Map 

return Out_Guard_Map is 
M : Out_Guard_Map; 
begin 

Create (Empty_Expression, M) ; 
return M; 

end Empty_Out_Guard_Map; 

— Returns an empty out_guard_map; 



function Empty_Excep_Trigger_Map 

return Excep_Trigger_Map is 
M : Excep_Trigger_Map; 
begin 
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Create (Empty_Expression, M) ; 
return M; 

end Empty_Excep_Trigger__Map; 

-- Returns an empty excep_t rigger_map; 



function Empty_Trigger_Map 

return Trigger_Map is 
X : Trigger_Record; 

M : Trigger_Map; 
begin 

X.Tt := None; 

X. Streams := Emipty_Id_Set ; 
Create (X, M) ; 
return M; 

end Empty_Trigger_Map; 

-- Returns an empty trigger_map; 



function Empty_Timer_Op_Map return Timer_Op_Map is 
X : Timer_Op_Set ; 

M : Timer_Op_Map ; 
begin 

Empty (X) ; 

Create (X, M) ; 
return M; 

end Empty_Timer_Op_Map; 

”” Returns an emipty timer_op_map; 



function Empty_Timing_Map 

return Timing_Map is 
M : Timing_Map; 
begin 

Create (0, M) ; 
return M; 

end Empty_Timing_Map; 

-- Returns an empty timing_map; 



function Empty_Type_Declarat ion 

return Type_Declaration is 
X : Type_Name := null; 

M : Type_Declaration; 
begin 

Create (X, M) ; 
return K; 
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end Empty_Type_Declaration; 

-- Returns an empty type declaration map. 
end Psdl_Concrete_Type_Pkg; 
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APPENDIX J. SPECIFICATION OF PSDL GRAPH ADT 



— psdl_graph_s . a 



Unit name 
File name 
Author 

Date Created 
Modified by 
Address 
Last Update 



Specification of Psdl Graph ADT 
psdl_graph_s . a 

Valdis Berzins (berzins0taurus . cs . nps . navy .mil) 

December 1990 

Suleyman BAyramoglu 

bayram0taurus . cs . nps . navy.mil 

{Tue Sep 24 02:00:10 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



-- Keywords : abstract data types, graphs, PSDL 

— Abstract : 

Provides the supporting types to PSDL ADT 

Revision history 



-“SSource : 

/n/gemini/work/bayram/AYACC/parser//RCS/psdl_graph_s . a, V $ 
--SRevision: 1.5 $ 

— $Date: 1991/09/24 09:33:35 $ 

— SAuthor; bayram $ 



REFERENCES 



[1] Reference Manual for the Ada Programming Language, 
ANSI/MIL-STD-1815A-1983. 

============= LIBRARIES, ETC. === = 
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— PSDL_CONCRETE_TYPE_PKG 

GENERIC_SET_PKG defines a generic set type 
GENERIC_MAP_PKG defines a generic map type 

with GENERIC_MAP_PKG, 

GENERIC_SET_PKG, 

PSDL_CONCRETE_TYPE_PKG; 

use PSD L_CON CRE TE_T YP E_P KG ; 

package PSDL_GRAPH_PKG is 

TYPE SPECIFICATIONS 




type PSDL_GRAPH is private; 



— An EDGE represents a data stream from operator X to operator Y. 

— Since there can exist more than one data stream between X and Y, 
the name STREAM_NAME identifies a unique data stream. 

In this way, the use ofSTREAM_NAME allows several streams 
with different names to connect the 
same pair of operators, X and Y. 

type EDGE is record 

X, 

Y, 

STREAM_NAME : PSDL_ID; 
end record; 



package EDGE_SET_PKG is 

new GENERIC_SET_PKG(t => EDGE, block_size => 12); 

subtype EDGE_SET is EDGE_SET_PKG . SET; 
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CONSTRUCTOR OPERATIONS 



+ 






— Returns the graph with no vertices and no edges, 
function EMPTY_PSDL_GRAPH return PSDL_GRAPH; 

function ADD_VERTEX ( 

OP_ID 
G 

MAXIMUM_EXECUTlON_TIME 
return PSDL_GRAPH; 

function ADD_EDGE(X, 

Y, 

STREAM_NAME : PSDL_ID; 

G : PSDL_GRAPH; 

LATENCY : MILLISEC 0) 

return PSDL GRAPH; 



PSDL_ID; 
PSDL_GRAPH; 
MILLISEC := 0) 






ATTRIBUTE OPERATIONS 






— HAS_VERTEX() returns TRUE if 

— and only if OP_ID is a vertex in G. 
function HAS_VERTEX (OP_ID : PSDL_ID; 

G : PSDL_GRAPH) 

return BOOLEAN; 



HAS_EDGE() returns TRUE if and only if 
— there exists an edge from vertex 
X to vertex Y in G. 
function HAS_EDGE(X, Y: PSDL_ID; 

G : PSDL_GRAPH) 
return boolean; 



STREAI’^_NAMES ( ) accepts arguments for vertices and the graph. 
The function returns the names of the data streams 
connecting operator X and operator Y. 
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The result can be empty if there are no streams 
between X and Y, and it can have more than one element 
if several stream.s connect X and Y. 
function STREAM_NAMES (X, 

Y: PSDL_ID; 

G: PSDL_GRAPH) 

return id_set; 

-- The maximum execution time allowed for the operator V. 
function MAXIMUM_EXECUTION_TIME (V: PSDL_ID; 

G: PSDL_GRAPH) 

return MILLISEC; 

The maximum data transmission delay between 
a write operation by 

operator X on the given stream and the 
corresponding read operation by 
operator Y. 
function LATENCY (X, 

Y, 

STREAM_NAME : PSDL_ID; 

G : PSDL_GRAPH) 

return MILLISEC; 

The maximum data transmission delay between 
the last write operation 

by operator X and the first read operation 
by operator Y. Zero if 
there are no edges between X and Y, 
the largest latency of the edges if 
several edges connect X and Y. 
function LATENCY (X, 

Y : PSDL_ID; 

G : PSDL_GRAPH) 
return MILLISEC; 

The set of all vertices in G. 
function VERTICES (G : PSDL_GRAPH) 
return ID SET; 



The set of all edges in G. 
function EDGES (G : PSDL_GRAPH) 
return EDGE_SET; 
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The set of all vertices U with an EDGE from V to U in G 
function SUCCESSORS (V : PSDL_ID; 

G : PSDL_GRAPH) return ID_SET; 

The set of all vertices U with an EDGE from U to V in G 
function PREDECESSORS (V : PSDL_ID; 

G: PSDL GPxAPH) return ID SET; 



private 

package riAXIMUM_EXECUTION_TIME_MAP_PKG is 
new GENERIC_MAP_PKG(KEY => PSDL_ID, 

RESULT => MILLISEC) ; 

type KAXir‘^vi_EXECUTlON_TIME_MAP is 

new KxAXIMUM_EXECUTION_TIME_MAP_PKG.MAP; 

package LATENCY_MAP_PKG is 

new GENERIC_MAP_PKG (KEY => EDGE, 

RESULT => MILLISEC); 

type LATENCY_MAP is new LATENCY_MAP_FKG . MAP ; 



type PSDL_GRAPH is record 

ID_SET; 

EDGE_SET; 

MAXIMUM_EXECUTION_TIME_MAP ; 
LATENCY_MiAP ; 

end record; 
end PSDL GRAPH PKG; 



EDGES 

MAXIMUM_EXECUTION_TIME 

LATENCY 
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APPENDIX K. IMPLEMENTATION OF PSDL GRAPH ADT 



— psdl_graph_b . a 



Unit name 
File name 
Modified by 
Address 
Last Update 



Implementation of Psdl Graph ADT 
psdl_graph_b . a 
Suleyman BAyramoglu 
bayram0taurus . cs . nps . navy.mil 
{Tue Sep 24 02:00:10 1991 - bayram} 



— Machine/System Compiled/Run on 



Sun4, SunOS 4.1.1, 
Verdix Ada version 6.0 



(c) 



— Keywords : abstract data types, graphs, PSDL 

— Abstract : 

Provides the supporting types to PSDL ADT 

Revision history 

--SSource : /n/gemini/work/bayram/AYACC/parser//RCS/psdl_graph_b . a, v $ 
— SRevision: 1.3 $ 

~“$Date: 1991/09/24 09:52:09 $ 

--SAuthor: bayram $ 



package body PSDL_GRAPH_PKG is 






I 



CONSTRUCTOR OPERATIONS 



EMPTY_PSDL_GRAPH : Returns the graph with no vertices and no edges. 

Uses the function EMPTY_ID_SET from PSDL_CONCRETE_TYPE_PKG, 
procedure 

EMPTY 0 from GENERIC_SET_PKG, 

and procedure CREATE ( ) from GENERIC_MAP_PKG . G is the 
new (empty) PSDL_GRAPH that gets returned to the caller. 

function EMPTY_PSDL_GRAPH return PSDL_GRAPH is 

G : PSDL GRAPH; 



begin 



G . VERTICES : = PSDL_CONCRETE_TYPE_PKG . EMPTY_ID_SET; 
EDGE_SET_PKG. EMPTY (G. EDGES) ; 

CREATE (0, G.MAXIMUI'1_EXECUTION_TIME) ; 

CREATE (0, G. LATENCY) ; 



return G; 

end EMPTY_PSDL_GRAPH; 

ADD_VERTEX: Adds a single vertex (labeled OP_ID) to G. 

The caller may specify a MAXIMUM_EXECUTION_TIME for the vertex or 
accept the default of zero. H is the nev; PSDL_GRAPH. That is, 

H = G + (the new vertex) . 

function ADD_VERTEX (OP_ID : PSDL_ID; 

G : PSDL_GRAPH; 

MxAXIMUM_EXECUTION_TIME : MILLISEC := 0) 
return PSDL GPJVPK is 



H : PSDL GRAPH := G; 



begin 

Add OP_ID to the vertex set and then use 

— the GENERIC_MJ\P_PKG procedure 

— BINDO to bind the OP_ID to its MAXIMUI^i_EXECUTION_TIME and 
updates the new graph's map accordingly. 

PSDL_CONCRETE_TYPE_PKG. ID_SET_PKG . ADD (OP_ID, H. VERTICES) ; 
BIND(OP_ID, MiAXIMUM_EXECUTION_TIME, H.MAXIMUI^ EXECUTION TIME) ; 
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return H; 



end ADD VERTEX; 



ADD_EDGE: Adds a directed edge from X to Y in G. 

The edge takes on the name STREAM_NAME, supplied by the caller. 
The caller may also specify a LATENCY for the edge (or accept the 
default of zero. H is the new PSDL_GRAPH. That is, 

H = G -f (the new edge) . 

function ADD_EDGE(X, Y, STREAM_NAME : PSDL_ID; 

G : PSDL_GRAPH; LATENCY : MILLISEC := 0) 
return PSDL GRAPH is 



E : EDGE; 

H : PSDL_GRAPH G; 
begin 

Assign to components of the edge E...ADDO the edge E to H...and 
finally, update the LATENCY map of H with the (argument) LATENCY 
for the edge E. 

E.X := X; 

E.Y := Y; 

E . S TRE AK_NAME : = S TRE AI<^_NAME ; 

EDGE_SET_PKG. ADD (E, H. EDGES) ; 

BIND (E, LATENCY, H . LATENCY) ; 

return H; 

end ADD EDGE; 



ATTRIBUTE OPERATIONS 



HAS_VERTEX() returns TRUE if and only if OP_ID is a vertex in G. 
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function HAS_VERTEX (OP_ID : PSDL_ID; 

G : PSDL_GRAPH) 

return BOOLEAN is 

begin 

return 

PSDL_CONCRETE_TYPE_PKG . ID_SET_PKG .MEMBER (OP_ID, G . VERTICES ) 
end HAS VERTEX; 



HAS_EDGE() returns TRUE if and only if there exists 
-- an edge from vertex 
X to vertex Y in G. 

First we find the LAST_INDEX for the EDGES of G, 
then we loop from 

the first to the last ELEMENT and compare X and Y. 
If we obtain a 

match at any time, we return TRUE. 

If we search the entire list with 
no success, FALSE is returned. 

function HAS_EDGE(X, Y : PSDL_ID; 

G : PSDL_GRAPH) 
return BOOLEAN is 

e : EDGE; 

local_x : psdl_id:=x; 

local_y : psdl_id:=y; 

begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(e : edge) is 
begin 

if (e.X = local_X) and then (e.y = local_y) then 
raise edge_set_pkg . return_f rom_f oreach ; 
end if; 

end loop_body; 
procedure execute_loop is 
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new edge_set_pkg . generic_scan (loop_body) ; 

begin 

execute_loop (g. edges) ; 
exception 

when edge_set_pkg . return_f rom_foreach => return true; 
end; 

— LIMITATIONS: Square brackets are used as macro 

— quoting characters, 

-- so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the 

— lower case spellings of 

— the identifier names ’’DEFINE”, ’’UNDEFINE”, and "DNL’’, 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro. 



end HAS_EDGE; 

STREAM_NAMES ( ) accepts arguments for vertices and the graph. The 
function returns the name(s) of the data stream(s) 
connecting operator 

X and operator Y. The result can be empty if there is no stream 
between X and Y, and it can have more than one element if several 
streams connect X and Y. 

The function starts by assigning the size of the edge set of G to 
LAST_INDEX and making S an empty ID_SET. 

— Next, we loop from 1 until 

the LAST_INDEX, looking at the EDGES in G. When we find an EDGE 
from X to Y, the corresponding STREAM_NAME is added to S. 

function STREAM_NAMES (X, Y : PSDL_ID; 

G : PSDL_GRAPH) 
return ID_SET is 

e 
s 

local_x 
local_y 

begin 



ID_SET 
psdl_id 
psdl id 



= PSDL_CONCRETE_TYPE_PKG.EMPTY_ID_SET; 
= x; 
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— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(e : edge) is 
begin 

if (e.X = local_X) and then (e.y = local_y) then 
id_set_pkg . add (e . st ream_name, s) ; 
end if; 

end loop_body; 

procedure execute_loop is new edge_set_pkg . generic_scan (loop_body) ; 
begin 

execute_loop (g . edges) ; 
end; 

return S; 
end STREAIi NAMES; 



The maximum execution time allowed for the operator V. 

function MAXIMUM_EXECUTION_TIME (V : PSDL_ID; 

G : PSDL_GRAPH) 

return MILLISEC is 

Value to flag no such vertex in G? 

MET : MILLISEC := 0; 

begin 

— Search the MAXII^IUM_EXECUTION_TIME mapping of G 

— for the (key) vertex 

V. If the vertex is found, the corresponding 
-- time is returned; 

else, zero is returned. 

if HAS_VERTEX (V, G) then 

return FETCH (G .MAXII^JM_EXECUTION_TIME, V) ; 
else 

return MET; 
end if; 

end MAXIMUI^_EXECUTION_TIME; 

The maximum data transmission delay between a write operation by 
operator X on the given stream and the corresponding 
-- read operation by 
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operator Y. 



function LATENCY (X, Y, STREAK_NAME : PSDL_ID; 
G : PSDL_GRAPH) 
return MILLISEC is 

E : EDGE; 

T : MILLISEC := 0; 

begin 

E.X := X; 

E.Y := Y; 

E . STREAM_NAME := STREAM_NAME; 

if HAS_EDGE(X, Y, G) then 
return FETCH (G . LATENCY, E) ; 
else 

return T; 
end if; 

end LATENCY; 



— The maximum data transmission delay between the last write operation 
by operator X and the first read operation by operator Y. 

Zero if 

— there are no edges between X and Y, 
the largest latency of the edges if 
several edges connect X and Y. 

function LATENCY (X, Y ; PSDL_ID; 

G : PSDL_GRAPH) 
return MILLISEC is 



E 

L 

T 



local_x 

local_y 

begin 



EDGE; 

MILLISEC; 
MILLISEC := 0; 
psdl_id := x; 
psdl_id := y; 



if HAS_EDGE(X, Y, G) then 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(e : edge) is 
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begin 

if (E.X = local_X and E.Y = local_Y) then 
L := FETCH (G. LATENCY, E) ; 
if (L > T) then 
T := L; 
end if; 
end if; 

end loop_body; 
procedure execute_loop is 

new edge_set_pkg . generic_scan (loop_body) ; 

begin 

execute_loop (g. edges) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower 

— case spellings of 

— the identifier names ’’DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 
-- mention any index variables of the loop. 

-- End expansion of FOREACH loop macro, 
end if; 
return T; 

end LATENCY; 

The set of all vertices in G. 
function VERTICES (G : PSDL_GPJkPH) return ID_SET is 
begin 

return G. VERTICES; 
end VERTICES; 



The set of all edges in G. 
function EDGES (G : PSDL GRAPH) return EDGE SET is 
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begin 



return G. EDGES; 
end EDGES; 



The set of all vertices U with an EDGE from V to U in G. 
function SUCCESSORS (V : PSDL_ID; G : PSDL_GRAPH) return ID_SET is 
E : EDGE; 

S : ID_SET := PSDL_CONCRETE_TYPE_PKG . EMPTY_ID_SET; 



begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(e : edge) is 
begin 

if (E.X = V) then 

ID_SET_PKG.ADD(E.Y, S) ; 
end if; 

end loop_body; 
procedure execute_loop is 

new edge_set_pkg . generic_scan ( loop__body ) ; 

begin 

execute_loop (g . edges) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the 

— lov7er case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

““ End expansion of FOREACH loop macro. 

return S; 
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end SUCCESSORS; 



The set of all vertices U with an EDGE from U to V in G. 

function PREDECESSORS (V : PSDL_ID; 

G ; PSDL_GRAPH) 
return ID_SET is 

E : EDGE; 

S : ID_SET PSDL_CONCRETE_TYPE_PKG . EMPTY_ID_SET; 

begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(e : edge) is 
begin 

if (E.y - V) then 

ID_SET_PKG.ADD(E.x, S) ; 
end if; 

end loop__body; 
procedure execute_loop is 

new edge_set_pkg . generic_scan (loop_body ) ; 

begin 

execute_loop (g . edges) ; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 
-- so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid 
-- the lower case spellings of 

— the identifier names "DEFINE”, "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 
-- mention any index variables of the loop. 

-- End expansion of FOREACH loop macro. 

return S; 
end PREDECESSORS; 

end PSDL GRAPH PKG; 
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APPENDIX L. GENERIC SET PACKAGE 



— set s.a 



— ^Source: 

/n /gemini/ work/bay ram/ AYACC /parser /psdl_ada . lib/RCS/set_s . a, v $ 

— $Date: 1991/09/16 23:00:54 $ 

— ^Revision: 1.2 $ 

— This implementation is limited: the Ada and ” = ” operations 

— are not safe or correct for sets. 

— Use the "assign" and "generic_equal" procedures instead. 

— An Ada limited private type could not used because of restrictions 

— on generic in parameters of limited private types 

— (see generic_reduce) . 

— You should use the "recycle" procedure on block exit 

— or subprogram return 

— to reclaim storage for any local variables of 

— type set declared in the block 

— Sets are unbounded, but do not require heap storage unless 

— the size of the set exceeds the block size. 



with Text_IO; use Text_IO; 
generic 

type T is private; 

Block_Size: in NATURAL := 128; 

with function Eq(X, Y: T) return BOOLEAN is "="; 
package Generic_Set_Pkg is 
type SET is private; 

procedure Empty (S: out SET) ; 
procedure Add(X: in T; S: in out SET) ; 
procedure Remove(X: in T; S: in out SET); 

function Member (X: T; S: SET) return BOOLEAN; — x IN s . 
procedure Union (SI, S2 : in SET; S3: out SET); — s3 = si U s2. 
procedure Dif ference (SI, S2: in SET; S3: out SET); — s3 = si - s2. 
procedure Intersection (SI , S2 : in SET; S3: out SET); 

— generic 
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set { 1 1 ) . 



type other_set_type is private; 

— package generic_cross_product_pkg; 

function Size(S: SET) return NATURAL; 
function Equal (SI, S2 : SET) return BOOLEAN; 
function Subset (SI, S2 : SET) return BOOLEAN; 

— function proper_subset (si, s2: set) return boolean; 

generic 

with function ”<" (X, Y: T) return BOOLEAN is <>; 
with function Successor (X: T) return T; 
procedure Generic_Interval (XI, X2 : in T; S: out SET); — {xl .. x2}. 

generic 

type ET is private; — Element type for result, 
type ST is private; — Element set type for result, 
with function F(X: T) return ET is <>; 
with procedure Empty (S: out ST) is <>; 
with procedure Add(X: in ET; S: in out ST) is <>; 
procedure Generic_Apply (SI : in SET; S2 : out ST) ; 

generic 

with function F(X, Y: T) return T; 

Identity: T; 

function Generic_Reduce (S : SET) return T; 
generic 

with function F(X, Y: T) return T; 
function Generic_Reducel (S : SET) return T; 

generic 

with procedure Generate (X: in T) ; 
procedure Generic_Scan (S : SET) ; 

Exit_From_Foreach, Return_From_Foreach : exception; 

Empty_Reduction_Undef ined : exception; — Raised by reducel. 

-- System functions . 

procedure Assign (X: out SET; Y: in SET); — x := y 
procedure Recycle (S: in SET); 

— Recycles any heap storage used by s. 

— Call recycle (s) just before leaving any block where 
— a variable s: set is declared. 

— Text I/O procedures 

— Package lookahead_stream_pkg and procedure input are 
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— used instead of get 

— because text_io does not support examining a lookahead character 

— from an input file without moving past it. 

— One character lookahead is needed to parse Spec set syntax. 

— Format is { element, element, . . , element ) 

generic 

with procedure Input (Item: out T) is <>; 

-- Read a set element from the lookahead stream, stream_machine_pkg 
procedure Generic_Input ( Item: out SET); 

-- Read a set element from the lookahead stream, stream_machine_pkg . 
generic 

with procedure Input (Item: out T) is <>/ 

— Read a set element from the lookahead stream, stream_machine_pkg 
procedure Generic_File_Input (File : in File_Type; Item: out SET); 

— Read a set from the file, using lookahead from stream_machine_pkg 

— The generic put procedures are designed to work with the standard 

— put procedures provided by the predefined Ada data types. 

generic 

with procedure Put (Item: in T) is <>; 
procedure Generic_Put (Item: in SET) ; 

generic 

with procedure Put (File: in File_Type; Item: in T) is <>; 
procedure Generic_File_Put (File : in File_Type; Item: in SET) ; 

private 

type LINK is access SET; 

type ELEMENTS_TYPE is array (1 .. Block_Size) of T; 

type SET is 
record 

Size: NATURAL := 0; — The size of the set. 

Elements: ELEMENTS_TYPE; — The actual elements of the set. 
Next: LINK := null; — The next node in the list, 
end record; 

— Elements[l .. min(size, block_size] contains data, 
end Generic_Set_Pkg; 
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— set b.a 



— Warning: due to a bug in vedix Ada version 6.0, 

— it has been necessary to patch the definitions of 

— remove, member, difference, intersection, subset. 

— The compiler bug causes incorrect references to the 

— formal parameters of a 

— subprogram from within a locally declared subprogram (e.g. loop_body) 

— that is passed as a generic subprogram parameter in 
-- a generic instantiation. 

-- Patches introduce local copies of procedure parameters 
(such as local_x) 

— to work around a case where variable references get confused. 

-- If the compiler bug is fixed someday, these local copies can be 
-- removed. 



with unchecked_deallocation; 

with lookahead_pkg; use lookahead_pkg; 

with delimiter_pkg; use delimiter_pkg; 

— generic 

— type t is private; 

— block_size: in natural := 128; 

— with function eq(x, y: t) return boolean is 
package body generic_set_pkg is 

recycle_list : link := null; — The recycle list for recycling storage. 
nodes_in_recycle_list : natural := 0; — The length of the recycle list. 

nodes_in_use : natural 0; — The number of set heap nodes in use; 

— Invariant : nodes_in_recycle_list 

= length (recycle_list) <= nodes_in_use . 

— Local subprogram declarations. 

function copy_list(l: link) 
return link; 

function create (sz: natural; 

e: elements_type; 
next : link) 

return link; 
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function token return character; 



— End local subprogram declarations. 

— Constant declarations. 

blank: constant delimiter_array := initialize_delimiter_array ; 

— End constant declarations. 



SET PACKAGE PROCEDURES & FUNCTIONS 



-- note: called by details internal usage of functions and procedures. 

by default all instantiating programs are potential users as well. 

EMPTY 

— Procedure name: empty 

— Description: return an empty set 

— Called by: apply 



procedure empty (s: out set) is 
si: set; 
begin 
s := si; 
end empty; 





— Procedure name: add 

— Description: add an element to a set 



procedure add (x: in t; s: in out set) is 
begin 

if not (member (x, s) ) then 
s.size := s.size + 1; 
if s.size <= block_size then 
s . elements (s . size) := x; 
elsif s.next = null then 

s.next := create(l, (others => x), null); 
else 

add (x, s . next .all) ; 
end if; 
end if; 
end add; 
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•REMOVE 



— Procedure name: remove 

-- Description: remove an element from a set 

— Called by: 



procedure remove (x: in t; s: in out set) is 
ss: set; 

local_x: t := x; — patch to work around compiler bug, verdix 6.0. 
begin 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if not (eg ( local_x, y) ) then add(y, ss) ; end if; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (s) ; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 
-- so you must write [ [x] ] in the body of a FOREACH 
-- to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid the lower case spellings 
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of 



— the identifier names "DEFINE”, "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
recycle (s) ; 

s : = s s ; 
end remove; 



MEMBER 

— Function name: member 

— Description: test if an element is a member in a set 

— Called by: subset, add, union, difference, intersection 



function member (x: t; s: set) return boolean is 

local_x: t := x; -- patch to work around compiler bug, verdix 6.0. 
begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if eq(local_x, y) then raise return_f rom_f oreach / end if; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body) ; 
begin 

execute_loop (s) ; 
exception 

when return_from_f oreach => return true; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case 
-- spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
return (false) ; 

end member; 
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■UNION' 



-- Procedure name: union 

— Description: return the union of two input sets 

— Called by: 



procedure union (si, s2 : in set; s3: out set) is 
ss : set; — Initialized to empty, 
begin 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin add (y, ss) ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (si) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting 
-- characters, 

-- so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case 

— spellings of 

-- the identifier names ’’DEFINE”, ’’UNDEFINE”, and ”DNL”, 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro. 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin add (y, ss) ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body ) ; 
begin 

execute_loop (s2 ) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 
-- so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case 
-- spellings of 

-- the identifier names ’’DEFINE”, ’’UNDEFINE”, and ”DNL”, 

-- or must quote them like this: [define]. 
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-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro. 

s3 := ss; 

end union; 



DIFFERENCE 

-- Procedure name: difference 

-- Description: return a set difference of two input sets 
— Called by: 



procedure difference (si, s2 : in set; s3: out set) is 
ss : set; 

local_s2: set := s2; — patch to work around compiler bug, verdix 6.0. 
begin 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if not member (y, local_s2) then add(y, ss) ; end if; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop__body) ; 
begin 

execute_loop (si ) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 
-- so you must write [ [x] ] in the body of a FOREACH 

-- to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case 

— spellings of 

— the identifier names ’’DEFINE”, ’’UNDEFINE”, and ”DNL”, 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro. 
s3 := ss; 

end difference; 



INTERSECTION 

— Function name: intersection 

— Description: return a set intersection of two input sets 

— Called by: 
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procedure intersection (si, s2: in set; s3: out set) is 
ss : set; 

local_s2 : set := s2; — patch to work around compiler bug, verdix 6.0 
begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if member(y, local_s2) then add(y, ss) ; end if; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body ) / 
begin 

execute_loop (si) / 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters 
-- so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid the lower 
-- case spellings of 

-- the identifier names "DEFINE”, "UNDEFINE”, and "DNL”, 

— or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

-- Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
s 3 : = s s ; 

end intersection; 



SIZE 

-- Function name: size 

-- Description: return the number of elements in a set, zero if emipty 
— Called by: 



function size (s: set) return natural is 
begin 

return s.size; 
end size; 



EQUAL 

-- Function name: equal 

-- Description: tests if two sets are equal 
— Called by: 



function equal (si, s2 : set) return boolean is 
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bl, b2 : boolean; 
begin 

bl := subset (si, s2) ; 
b2 := subset (s2, si); 
return bl and b2; 
end; 



SUBSET 

— Function name: subset 

— Description: check if one set is a subset of another set 

— Called by: equal 



function subset (si, s2 : set) return boolean is 
il : natural := 1; 
result: boolean := true; 

local_s2: set := s2; — patch to work around compiler bug, verdix 6.0 
begin 

if si. size > s2.size then result := false; 
else — Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin if not (member (y, local_s2)) 

then result := false; raise exit_f rom_f oreach ; end if 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body) ; 
begin 

execute_loop (si) ; 
exception 

when exit_f rom_foreach => null; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters 

— so you must write [[x]] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops m.ust avoid the lower case 

— spellings of 

— the identifier names ’’DEFINE", ’’UNDEFINE’’, and ’’DNL’’, 

-- or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
end if; 

return result; 
end subset; 
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INTERVAL 



-- Procedure name: interval 

-- Description: get the elements of a sel that are within the input 
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interval 



— generic 

— with function ”<" (x, y: t) return boolean is <>/ 

— with function successor(x: t) return t; 

— ALL(x y: t :: x < y => successor(x) <= y) 
procedure generic_interval (xl, x2 : in t; s: out set) is 

ss: set; — Initialized to empty, 
y: t := xl; 
begin 

while not (x2 < y) loop — Invariant: xl <= y. 
add (y, ss) ; 
y := successor (y) ; 
end loop; 
s : = s s ; 

end generic_interval ; 



APPLY 

— Procedure name: apply 

— Description: apply function "f" on element of a set 

— Called by: 



— generic 

— type et is private; Element type for result. 

— type St is private; -- Element set type for result, 

with function f(x: t) return et is <>; 

— with procedure empty (s: out st) is <>; 

— with procedure add(x: in et; s: in out st) is <>; 

procedure generic_apply ( si : in set; s2: out st) is 

ss: st; 
begin 

empty (ss) ; 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin add (f (y) , ss) ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (si) / 
end; 

— LIMITATIONS: Square brac)cets are used as macro quoting characters, 

— so you must write [[x]] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid the lower case 
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-- spellings of 

— the identifier names "DEFINE”, "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
s 2 : = s s ; 

end generic_apply ; 



REDUCE 

-- Function name: reduce 

— Description: reduce set to an element by applying function "f" 

— Called by: 



— generic 

— with function f (x, y: t) return t; 

— identity: t; 

function generic_reduce ( s : set) return t is 
x: t := identity; 
begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin x := f (y, x) ; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body) ; 
begin 

execute_loop (s) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the 

— lower case spellings of 

-- the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
return x; 

end generic_reduce; 
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REDUCE 1 



-- Function name: reducel 

-- Description: same as reduce only without the identity element 
— Called by: 



— generic 

— with function f (x, y: t) return t; 
function generic_reducel (s : set) return t is 

x: t; 

i: natural := 1; 
begin 

if s.size = 0 then raise empty_reduction_undef ined; end if; 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if i = 1 then x := y; else x := f (y, x) ; end if; 

i : = i + 1 ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (s) ; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower 

— case spellings of 

— the identifier names ’’DEFINE”, ’’UNDEFINE”, and ”DNL”, 

-- or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
return x; 

end generic_reducel ; 





-- Procedure name: scan 
-- Description: frame of loop structure 
— Called by: 



-- generic 

with procedure generate (x: in t) ; 
procedure generic_scan (s : set) is 
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t: set := s; 
begin 

while t.next /= null loop 
for i in 1 . . block_size loop 
generate (t . elements (i) ) ; 
end loop; 
t := t. next. all; 
end loop; 

for i in l..t.size loop 
generate (t .elements (i) ) ; 
end loop; 
end generic_scan; 



ASSIGN 

— Function name: assign 

— Description: safe version of 



procedure assign(x: out set; y: in set) is 
begin 

x.size := y.size; 

X. elements := y. elements; 
x.next := copy_list (y . next ) ; 
end assign; 

RECYCLE 

— Procedure name: recycle 

— Description: destroys a set and reuses the associated storage 

— Called by: remove 



procedure recycle (s: in set) is 
1: link := s.next; 
head, temp: link; 

procedure free is new unchecked_deallocat ion (set, link) ; 
begin 

while 1 /- null loop 
head := 1; 

1 := l.next; 

nodes_in_use := nodes_in__use - 1; 
if nodes_in_recycle_list < nodes_in_use then 
temp := recycle_list ; 
recycle_list := head; 
recycle__list . next := temp; 

nodes_in__recycle_list := nodes_in_recycle_list + 1; 
else 

free (head) ; 
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end if; 
end loop; 
end recycle; 



LOCAL SUBPROGRAMS 



COPy_LIST 

— Function name: copy_list 

— Description: creates a distinct copy of a list representign a set. 
-- Called by: assign 



function copy_list(l: link) return link is 
begin 

if 1 = null then return 1; 

else return create ( 1 . size, 1. elements, copy^list ( 1 . next ) ) ; 
end if; 

end copy_list; 



CREATE 

-- Function name: create 

-- Description: create a new block of set elements 
— Called by: add 



function create (sz: natural; e: elements_type; next: link) return link 

1: link; 
begin 

nodes_in_use := nodes_in_use + 1; 
if recycle_list = null then 

return new setMsz, e, next); 
else 

1 := recycle_list ; 

recycle_list := recycle_list . next ; 

nodes_in_recycle_list := nodes_in_recycle_list - 1; 

1 . size := sz ; 

1. elements := e; 
l.next := next; 
return 1; 
end if; 
end create; 



•TOKEN' 
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-- Function name: token 

-- Description: get a non blank character from input 
— Called by: generic_input 



function token return character is 
— Blank is a constant array, see top of package body, 
begin 

— Advance the lookahead stream to a non-blank character, 
while blank (peek) loop skip_char; end loop; 

— Return the character without removing it from the stream, 
return peek; 

end token; 



GENERIC I/O PROCEDURES 



GENERIC-INPUT 



— Procedure name: generic input 

-- Description: input sets. Format is { element , element , , element } 

-- Called by: generic_f ile_input 
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generic 

with procedure input (item: out t) is <>; 

procedure generic_input (item: out set) is 
x: t; 

s: set; — Working copy of the result, initialized to empty, 
begin 
empty (s) ; 

if token /= M * then raise data_error; end if ; 

skip_char; — Pass over the opening left bracket, 
while token /= * } * loop 

input (x); — Read and pass over the next element of the set. 

add(x, s) ; — Add the element to the set. 

if token = ’ , ' then 
skip_char ; 

elsif token /= ’ } * then 
raise data_error; 

— if there is no comma we should be at the end of the set. 
end if; 

end loop; — Now the closing right brace is the lookahead character. 
skip_char ; 
item := s; 
exception 

when others => raise data_error; 
end generic_input; 



GENERIC-FILE- INPUT 

— Procedure name: generic file input 
-- Description: sets input from files 

— Called by : 



generic 

with procedure input (item: out t) is <>; 

procedure generic_f ile_input (f ile : in file_type; item: out set) is 
procedure get_set is new generic__input ; 
begin 

set_input ( f ile) ; — Connect the lookahead stream to the file. 

get_set (item) ; 

set_input (standard_input) ; — Restore the standard input file, 

end generic_f ile_input ; 
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GENERIC-PUT 

-- Procedure name: generic put 

— Description: output set. Format is { element , element , .. , element ) 

— Called by: 



— generic 

with procedure put (item: in t) is <>; 
procedure generic_put (item: in set) is 
i: natural := 1/ 
begin 

put (ascii . l_brace) ; 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if i > 1 then put (",")/ end if; 

put (y) ; i := i + 1; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body ) ; 
begin 

execute_loop ( item) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the body of a FOREACH 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower 
-- case spellings of 

-- the identifier names "DEFINE", "UNDEFINE", and "DNL", 

-- or must quote them like this: [define]. 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

-- Exit and return statements inside the body of a FOREACH loop 
-- work correctly only if the FOREACH loops are not nested. 

-- End expansion of FOREACH loop macro, 
put (ascii . r_brace) ; 
end generic_put ; 



GENERIC-FILE-PUT- 

— Procedure name: Generic file put 
-- Description: Output set to file 
-- Called by: 



— generic 

with procedure put (file: in file_type; item: in t) is <>; 
procedure generic_f ile_put ( f ile : in file_type; item: in set) is 
i: natural := 1 ; 
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macro . 



begin 

put (file, ascii. l_brace) ; 

-- Begin expansion of FOREACH loop 
declare 

procedure loop_body(y: t) is 
begin if i > 1 then put (file, ”, ”); end if; 

put (file, y) ; i := i + 1; 
end loop_body; 

procedure execute_loop is new generic_scan ( loop_body) ; 
begin 

execute_loop (item) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [[x]] in the body of a FOREACH 
-- to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower 

— case spellings of 

— the identifier names "DEFINE", "UNDEFINE”, and ”DNL”, 

— or must quote them like this: [define]. 

The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— work correctly only if the FOREACH loops are not nested. 

— End expansion of FOREACH loop macro, 
put (file, ascii . r_brace) ; 

end generic_f ile_put ; 



end generic_set_pkg; 
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APPENDIX M. GENERIC MAP PACKAGE 



— map_s . a 



— $Source : /n/gemini/work/bay ram/AYACC/parser/psdl_ada . lib/RCS/map_b . a , v $ 

— $Date: 1991/05/24 10:42:27 $ 

— $Revision: 1.5 $ 

— this implementation is limited: the ada and "=" operations 

— are not safe or correct for maps. 

— use the "assign" and "generic_equal " procedures instead. 

— you should use the "recycle" procedure on block exit or subprogram return 
-- to reclaim storage for any local variables of type map declared in the block 

-- maps are unbounded, but do not require heap storage unless 

— the size of the map exceeds the block_size. 



with generic_set_pkg ; 
with text^io; use text_io; 
generic 

type key is private; -- type of the domain element 

type result is private; -- type of the range element 
block_size: in natural := 12; — the memory allocation unit, 

with function eq_key(kl, k2: key) return boolean is 
with function eq__res(rl, r2 : result) return boolean is " = "; 

package generic_map_pkg is 
type pair is private; 
type map is private; 

package key_set_pkg is 

new generic_set_pkg (t => key, eq => eq_key, block_size => block_size) ; 
subtype key_set is key_set_pkg . set ; 
package res_set_pkg is 

new generic_set_pkg (t => result, eq => eq_res, block_size => block_size) ; 
subtype res_set is res_set_pkg . set ; 

procedure create (r: in result; m: out map); 
procedure bind(x: in key; y: in result; m: in out map) ; 
procedure remove (x: in key; m: in out map); 
procedure remove (s: in key_set; m: in out map) ; 
function fetch (m: map; x: key) return result; 
function member (x: key; m: map) return boolean; 
function equal (ml, m2: map) return boolean; 
function submap (ml, m2: map) return boolean; 
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function map_domain (m : map) return key__set; 
function map_range(m: map) return res_set; 
function map_def ault (m : in map) return result; 



generi c 

with procedure generate (k: in key; r: in result); 
procedure generi c^scan (m : in map); 

exit_f rom_f oreach, return_f rom_f oreach : exception; 



-- system functions. 

procedure assign (x: out map; y: in map); — x := y 
procedure recycle (m: in map); 

— recycles any heap storage used by m. 

— call recycle (m) just before leaving any block where 
-- a variable m: map is declared. 



-- text i/o procedures 

this package supports generic input of map 
{ [ key 1 , result 1 ] , [key 2 , result2 ] , ... , ; 

— the following generic procedures will read 

— package lookahe ad^st ream_pkg and procedure 

— because text_io does not support examining 

— from an input file without moving past it. 

— one character lookahead is needed to parse 



data in the following format: 
default ) 

and write the map data . 
input are used instead of get 
a lookahead character 

spec map syntax. 



generi c 

with procedure key_input(k: out key) is <>; 
with procedure res_input(r; out result) is <>; 
procedure generic_input (m : out map); 



generic 

with procedure key_put(k: in key) is <>; 
with procedure res_put(r: in result) is <>; 
procedure generic_put ( item : in map) ; 

generic 

with procedure key_put (f ile : in file_type; k: in key) is <>; 
with procedure res_put (f ile : in file_type; r: in result) is <>; 
procedure generic_f ile_put (f ile : in file_type; item: in map); 
private 

type pair is 
record 

key_val: key; 
res_val: result; 
end record; 



function pair_eq(x, y: pair) return boolean; 
package pair_set_pkg is 

new generi c_set_pkg (t => pair, eq => pair_eq, block_size => block_size) ; 
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subtype pair_set is pa ir_set_pkg . set ; 

type map is 
record 

def_val: result; -- default value supplied by user 
pairs: pair_set; 
end record; 
end generic_map_pkg; 



-- map_b.a 



$Source: /n / gemini /work /bayram/AYACC/parser/psdl_ada . lib/RCS/map_b . a , v $ 

— $Date: 1991/09/24 10:42:27 $ 

-- $Revision: 1.5 $ 

-- $Log: map_b.a,v $ 

— Revision 1.5 1991/09/24 10:42:27 bayram 

__ *** empty log message *** 

-- warning: due to a bug in vedix ada version 6.0, 

— it has been necessary to patch the definitions of 

— fetch, member. 

— the compiler bug causes incorrect references to the formal parameters of a 

— subprogram from within a locally declared subprogram (e.g. loop_body) 

— that is passed as a generic subprogram parameter in a generic instantiation . 

— patches introduce local copies of procedure parameters (such as local_x) 

— to work around a case where variable references get confused. 

— if the compiler bug is fixed someday, these local copies can be removed. 



1 ookahead_pkg; 
delimiter pkg; 



with lookahead_pkg; use 
with delimiter_pkg; use 
with text_io; use text_io; 
— generic 

type key is private; 
type result is private; 
with function eq_key(kl, 
with function eq_res(rl, 
package body generic_map_pkg 



-- type of the domain element 
-- type of the range element 
k2 : key) return boolean; 

r2 ; result) return boolean; 

IS 



— local subprogram declarations 
function token return character; 

— constant declarations 
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blank: constant del imiter__array := initialize_delimiter_array ; 

create 

-- procedure name: create 

— description: creates a map instance and sets the user supplied default 



procedure create (r: in result; m: out map) is 

mm : map; 
begin 

mm.def_val := r; 
pair_set_pkg . empty (mm .pairs) ; 
m : = mm; 
end create; 



bind 

— procedure name: bind 

— description: adds an element to an existing map 



procedure bind(x: in key; y; in result; m: in out map) is 
p : pair; 
begin 

remove (x, m) ; 
if y /= m.def_val then 
p.key_val := x; 
p . res__val : = y ; 
pair_set_pkg . add (p, m. pairs); 
end if; 
end bind; 



remove 

— procedure name: remove 

— description: removes an element from a map 



procedure remove (x: in key; m: in out map) is 
p: pair; 
begin 

if member (x, m) then 
p.key_val := x; 
p.res_val := f etch (m, x) ; 
pair__set_pkg . remove (p, m. pairs); 
end if; 
end remove; 



remove 

— procedure name: remove 

— description: removes a set of elements from a map 
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procedure remove (s: in key_set; m: in out map) is 
p: pair; 
begin 

-- for k: key in generic_scan ( s) loop 

— remove ( k , m) ; 

-- end loop; 

— begin expansion of foreach loop macro, 
declare 

procedure loop_body{k; key) is 
begin remove (k, m) ; 
end loop_body; 

procedure execute_loop is new key_set_pkg . gene ric_scan ( loop_body ) ; 
begin 

execute_loop (s) ; 
end; 

— limitations: square brackets are used as macro quoting characters, 

-- so you must write [[x]] in the m4 source file 

-- to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 
-- the identifier names "define", "undefine", and "dnl", 

— or must quote them like this: [define] . 

-- the implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 

— mention any index variables of the loop. 

— end expansion of foreach loop macro, 
end remove; 



fetch 

— function name: fetch 

— description: returns the range value of a map for a given domain value 



function fetch (m: map; x: key) return result is 
y: result := m.def_val; 

local_x: key := x; -- patch to work around compiler bug, verdix 6.0. 
begin 

— begin expansion of foreach loop macro, 
declare 

procedure loop_body{p: pair) is 
begin if eq_key (p . key_val, local_x) 
then y := p.res_val; raise exit_f rom_f oreach ; end if; 
end loop_body; 

procedure execute_loop is new pair_set_pkg . generic_scan (loop_body ) ; 
begin 

execut e_loop (m . pairs ) ; 
exception 

when exit_f rom_f oreach => null; 
end; 
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— limitations: square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 
-- to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 
-- the identifier names "define", "undefine", and "dnl", 

— or must quote them like this: [define]. 

— the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 
-- may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— end expansion of foreach loop macro, 
return (y) ; 

end fetch; 



member 

— function name: member 

— description: indicates whether an element is a member of a map 



function member (x: key; m: map) return boolean is 
p: pair; 

found: boolean := false; 

local_x: key := x; -- patch to work around compiler bug, verdix 6.0. 
begin 

— begin expansion of foreach loop macro, 
declare 

procedure loop__body (p : pair) is 

begin if eq_key (p . key_val , local_x) then raise return_f rom_f oreach ; end if 
end loop_body; 

procedure execute_loop is new pair_set_pkg . generic_scan ( loop_body ) ; 
begin 

execute_loop (m .pairs) ; 
exception 

when return_from_f oreach => return true; 
end; 

— limitations: square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the m4 source file 
-- to get [x] in the generated ada code. 

-- ada programs using foreach loops must avoid the lower case spellings of 
-- the identifier names "define", "undefine", and "dnl", 

— or must quote them like this: [define]. 

-- the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 

— mention any index variables of the loop. 

— end expansion of foreach loop macro, 
return (false ) ; 
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end member; 



equal 

— function name: equal 

~~ description: indicates whether or not two maps are equal by determining 

whether each map is a submap of the other. 



function equal (ml, m2: map) return boolean is 
bl , b2 : boolean ; 
begin 

return ( submap (ml , m2) and then submap (m2, ml)); 

end equal; 



submap 

— function name: submap 

-- description: indicates whether one map is a subset of another map by 

— determining whether the set of domain and range values of 

— one map is a subset of the domain and range values of the 

— other. 



function submap (ml, m2: map) return boolean is 
begin 

return ( (map_default (ml ) = map_def ault (m2 ) ) and then 

(pair_set_pkg .subset (ml .pairs, m2 .pairs) ) ) ; 
end submap; 



map_domain 

— function name: map_domain 

— description: returns the set of domain values for a map 



function map_domain (m : map) return key_set is 
k_set : key_set; 

begin 

key_set_pkg . empty (k_set) ; 

-- begin expansion of foreach loop macro, 
declare 

procedure loop_body(p: pair) is 

begin key_set_pkg . add (p . key_val , k_set); 

end loop_body; 

procedure execute_loop is new pair_set_j>kg . generic_scan ( loop_body ) ; 
begin 

execute_loop (m .pairs) ; 
end; 

— limitations: square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 

— to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 
-- the identifier names "define", "undefine", and "dnl", 
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-- or must quote them like this: [define], 

— the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— end expansion of foreach loop macro, 
return k_set; 

end map domain; 



map_range 

-- function name: map_range 

-- description: returns the set of range values for a map 



function map_range(m: map) return res_set is 
r_set : res_set; 
begin 

re s_set_pkg . empty ( r_set ) ; 

-- begin expansion of foreach loop macro, 
declare 

procedure loop_body(p: pair) is 

begin res_set_pkg . add (p . res_val, r_set); 

end loop_body; 

procedure execute_loop is new pair_set_pkg . generic_scan ( loop_body ) ; 
begin 

execute_loop (m . pairs ) ; 
end; 

— limitations: square brackets are used as macro quoting characters, 

-- so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 

— the identifier names "define", "undefine", and "dnl", 

-- or must quote them like this: [define]. 

— the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 

— mention any index variables of the loop. 

— end expansion of foreach loop macro. 
res_set_pkg . add (m . def_val, r_set ) ; 
return r_set; 

end map_range; 



map_default 

— function name: map_default 

— description: returns the default value of a map 
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function map_def ault (m : in map) return result is 
begin 

return m.def_val; 
end map_default; 



scan 

-- procedure name: scan 

-- description: generic procedure which provides the capability to move 

through a map, one element at a time, performing a generic 
procedure on each element. 



— generic 

-- with procedure generate (k: in key; r: in result); 

procedure generi c_scan (m : in map) is 

begin 

— begin expansion of foreach loop macro, 
declare 

procedure loop_body(p: pair) is 
begin gene rate (p . key_val , p.res_val); 
end loop_body; 

procedure execute_loop is new pair_set_pkg . generic_scan ( loop_body ) ; 
begin 

execute_loop (m . pai rs ) ; 
end; 

-- limitations: square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 
-- to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 

— the identifier names "define", "undefine", and "dnl", 

-- or must quote them like this: [define] . 

— the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— end expansion of foreach loop macro, 
end generic_scan; 



assign 

— function name: assign 
-- description: safe version of ":=". 



procedure assign (x: out map; y: in map) is 
begin 

x.def_val := y.def_val; 

pair_set__pkg . assign (x. pairs, y. pairs); 
end assign; 
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recycle 



— procedure name: recycle 

-- description: destroys a map and reuses the associated storage 

— called by: remove 



procedure recycle (m : in map) is 
begin 

pair_set_pkg . recycle (m . pairs) ; 
end recycle; 



generic_input 

— procedure name: generic_input 

-- description: binds a sequence of elements from the keyboard 



— generic 

-- with procedure key_input(k: out key) is <>; 

-- with procedure res_input(r: out result) is <>; 
procedure generic_input (m : out map) is 
x: key; 
y: result; 

ml : map; 
begin 

if token /= ’ { ' then raise data_error; end if; 

skip_char; 

while token /= ' } ' loop 

if token /= ’ [' then raise data_error; end if; 
skip_char ; 
key_input ( x) ; 

if token /= ' then raise data_error; end if; 

skip_char ; 
re s_input (y ) ; 

if token /= ’] ' then raise data_error; end if; 

skip_char ; 
bind (x, y , ml ) ; 

if token = ’ , ’ then skip_char; 
elsif token = then 

skip_char; 

res__input (ml .def_val) ; 

if token = ' } ' then skip_char; else raise data_error; end if; 

exit ; 

else raise data_error; 
end if; 
end loop; 
m : = m 1 ; 
exception 

when others => raise data_error; 
end generic_input ; 
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generic_put — 

— procedure name : generic^put 

— description: outputs map data to the screen 



— generic 

— with procedure key_put(k: in key) is <>; 

— with procedure res_put(r; in result) is <>; 

procedure gene ric_put ( it em : in map) is 

i: natural := 1; 
begin 

put ("{") ; 

— begin expansion of foreach loop macro, 
declare 

procedure loop_body(k: in key; r: in result) is 
begin if i > 1 then put(", " ) ; end if; 

put("["); key_put(k); put ( " , "); res_put(r); put ( " ] " ) ; 

i ; = 1 + 1 ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (item) ; 
end; 

— limitations; square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated ada code. 

— ada programs using foreach loops must avoid the lower case spellings of 

— the identifier names "define", "undefine", and "dnl", 

— or must quote them like this: [define] . 

— the implementation requires each package to be generated by 

— a separate call to mA : put each package in a separate file. 

-- exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— end expansion of foreach loop macro. 
put("; "); res_put (map^def ault (item) ) ; 
put ("}"); 

end generic_put; 



generic_f ile_put 

— procedure name: gener ic_f ile_put 
-- description: outputs map data to the screen 



— generic 

— with procedure key_put ( f i le : in file_type; k: in key) is <>; 

— with procedure re s_put ( f ile : in file_type; r: in result) is <>; 
procedure generic_f i le_put ( f ile : in file_type; item: in map) is 

i : natural : = 1 ; 
begin 
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put(file, 

— begin expansion of foreach loop macro, 
declare 

procedure loop_body(k: in key; r: in result) is 

begin if i > 1 then put (file, ", "); end if; 

put (file, " [ " ) ; key_put (f lie, k) ; put (file, ", ") ; 

res_put (f ile, r) ; put (file, "]"); 

1 := i + 1; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute^loop (item) ; 
end; 

— limitations: square brackets are used as macro quoting characters, 

— so you must write [ [x] } in the m4 source file 

— to get [x] in the generated ada code. 

-- ada programs using foreach loops must avoid the lower case spellings of 

— the identifier names "define", "undefine", and "dnl", 

— or must quote them like this: [define]. 

— the implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— exit and return statements inside the body of a foreach loop 

— may not work correctly if foreach loops are nested. 

— an expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— end expansion of foreach loop macro. 

put (file, "; "); res^put (file, map_default (item) ) ; 

put (file, "}"); 
end generic_f ile_put ; 



local subprograms 



pa i r_eq 

-- procedure name: pair^eq 

— description: used to check equality of pairs, for supporting pair sets. 



function pair_eq(x, y: pair) return boolean is 
begin 

return eq_key (x . key_val , y,key_val) and then eq_res (x . res_val, y. res_val) ; 
end pair_eq; 



token 

-- procedure name: token 

— description: used to parse input characters from input stream 



function token return character is 

— blank is a constant array, see local constants section of package body 
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begin 

-- advance the lookahead stream to a non-blank character 
while blank (peek) loop 
skip_char; 
end loop; 

— return the character without removing it from the stream 
return peek; 
end token; 

end generic map_pkg; 
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APPENDIX N. GENERIC SEQUENCE PACKAGE 



— seq_s . a 



-- SSource: /n/gemini/work/bayrain/AyACC/parser/psdl_ada . lib/RCS/seq_s . a, v $ 

— $Date: 1991/09/24 10:42:27 $ 

— $Revi Sion : 1.5 $ 

-- This implementation is limited: the Ada and operations 

— are not safe or correct for sequences. 

— Use the "assign" and "generic_equal " procedures instead. 

— An Ada limited private type could not used because of restrictions 

— on generic in parameters of limited private types (see generic_reduce) . 

— You should use the "recycle" procedure on block exit or subprogram return 

— to reclaim storage for any local variables of type sequence declared in ' 

— the block. 

— Sequences are unbounded, but do not require heap storage unless 

— the length of the sequence exceeds the block_size. 



with generic_set_pkg; 

— with max; 

— with square_root_pkg; use square_root_pkg; 
with text_io; use text_ic; 

generic 

type t is private; 
block__size : in natural := 8; 

— average_size ; in natural := 8; 

— The average number of elements per sequence, for efficiency, 
package gene ric_sequence_pkg is 

type sequence is private; 

type index_array is array (natural range <>) of natural; — used by fetch #2. 

package natural_set__pkg is new generic_set_pkg (natural ) ; 
subtype natural_set is natural_set_pkg . set ; 

procedure empty (s: out sequence); 
procedure add(x: in t; s: in out sequence); 

generic 

with function eq(x, y: t) return boolean is <>; 
procedure generic_remove (x : in t; s: in out sequence); 

procedure append(sl, s2 ; in sequence; s: out sequence); -- s := si || s2 . 
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si [s2] . 



function fetch (s: sequence; n: natural) return t; -- s[n] . 



procedure fetch (si: sequence; 
procedure fetch (si: sequence; 

— s 1 [ low . . high] 
function length (s: sequence) 

function domain (s: sequence) 



ia: index_array; s: out sequence); 

low, high: natural; s: out sequence) 

return natural; 
return natural set; 



generic 

with function eq(x, y: t) return boolean is <>; 
function gener ic_membe r ( x : t; s: sequence) return boolean; — x IN s. 

generic 

with function eq(x, y: t) return boolean is <>; 
function gener ic_part_of (s 1 , s2: sequence) return boolean; — si IN s2 . 

generic 

with function eq(x, y: t) return boolean is <>; 
function generic_equal ( s 1 , s2: sequence) return boolean; 

generi c 

with function (x, y: t) return boolean is <>; 
function generic_less_than (si , s2: sequence) return boolean; 

generic 

with function "<"(x, y: t) return boolean is <>; 
with function eq(x, y: t) return boolean is <>; 
function generic_less_than_or_equal ( si , s2 : sequence) return boolean; 

generi c 

with function "<" (x, y: t) return boolean is <>; 
function gener ic_greater_than ( si , s2 : sequence) return boolean; 

generic 

with function "<"(x, y: t) return boolean is <>; 
with function eq(x, y: t) return boolean is <>; 
function generic_greater_or_equal ( si , s2 : sequence) return boolean; 

generi c 

with function eq(x, y: t) return boolean is <>; 
function generic_subsequence (si , s2: sequence) return boolean; 

generi c 

with function (x, y: t) return boolean is <>; 

with function successor(x: t) return t; 

— ALL (x y: t : : x < y => successor (x) <= y) 

procedure generi c_interval (xl , x2 : t; s: out sequence); -- xl .. x2 . 



generic 

type et is private; 

type St IS private; st = sequencefet} 

with function f(x: et) return t; 
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with function length (s ; st) return natural is <>; 
with function fetch (s: st; n: natural) return et is <>; 

procedure generic_apply ( si : st; s2 : out sequence); 

generic 

with function f (x, y: t) return t; 
identity: t; 

function generic_reduce ( s : sequence) return t; 
generic 

with function f (x, y: t) return t; 
function generic_reduce 1 (s : sequence) return t; 

generic 

with procedure generate (x: in t) ; 
procedure generic_scan ( s : sequence); 

exit^f rom_f oreach, return_f rom_f oreach : exception; 

— System functions. 

procedure assign (x : out sequence; y: in sequence); — x y 
procedure recycle (s: in sequence); 

— Recycles any heap storage used by s. 

— Call recycle (s) just before leaving any block where 
— a variable s: sequence is declared. 

— Text I/O procedures 

-- Package lookahead_pkg and procedure input are used instead of get 
-- because text^io does not support examining a lookahead character 

— from an input file without moving past it. 

— One character lookahead is needed to parse Spec sequence syntax, 
generic 

with procedure input (item: out t) is <>; 

— Read a sequence element from the lookahead stream, st ream_machine_pkg . 
procedure generic^input (item : out sequence); 

Read a sequence element from the lookahead stream, st ream_machine_pkg . 

generic 

with procedure input (item: out t) is <>; 

— Read a sequence element from the lookahead stream, st ream_machine_pkg . 
procedure generic_f ile_input (item : out sequence; file; in file_type) ; 

— Read a sequence from the file, using lookahead from stream_machine_pkg . 

— The generic put procedures are designed to work with the standard 

— put procedures provided by the predefined Ada data types. 

generic 

with procedure put (item: in t) is <>; 
procedure generic_put ( item : in sequence); 
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generic 

with procedure put (file: in file_type; item: in t) is <>; 
procedure generic_f ile_put (f lie : in file__type; item: in sequence); 

bounds_e rror : exception; -- Raised by fetch. 

empty_reduct ion_undef ined : exception; — Raised by reducel. 
private 

-- A linked list containing up to block_size elements per node. 

— The header node is contained directly in the variable. 

— Distinct sequences are contained in distinct memory locations, 

-- so the representation data structures can be safely modified without 

— risk of interference. 



type link is access sequence; 

— Let a = average_size, b - block_size, 

— p = tbit s /pointer , e = tbit s/element of type t 

Expected space overhead = o = (a/b) *p + (b/2)*e 

— minimize o; do/db = 0 = “ap/b*b +e/2 

— optimal b = sqrt ( 2 ^ a * p/e ) 

block_size : constant natural 

— := max(l, natural ( square_root ( fl oat (2 * average_size * link' size) 

/ float (t ' size )))) ; 



type element s_type is array(l .. block_size) of t; 



type sequence is 
record 

length: natural := 0; -- The length of 

elements: el ements_t ype ; -- A prefix of 

next: link := null; — The next node 

end record; 

— Elements[l .. min (length, block_size) ] 
end generic_sequence_pkg; 



the sequence . 
the sequence . 
in the list. 

contains data. 



— seq_b.a 



— $Source; /n/gemini/work/bayram/AYACC/parser/psdl_ada . lib/RCS/seq_b . a, v $ 

— $Date: 1991/09/24 10:42:27 $ 

— SRevision: 1.5 $ 

-- Warning: due to a bug in vedix Ada version 6.0. 

— it is necessary to patch the definitions of 

— generic_remove and generic_member , 

— to introduce local copies of procedure parameters (such as local_x) 

— to work around a case where variable references get confused. 
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with unchecked_deallocation; 

with lookahead_pkg; use lookahead_pkg; 

with delimiter_pkg; use delimiter_pkg; 

— generic 

— type t is private; 

— block_size: in natural := 32; 
package body generic_sequence_pkg is 

use natural_set_pkg; -- For the domain operation. 

recycle_list : link := null; -- The recycle list for recycling storage. 
nodes_in_recycle_list : natural := 0; — The length of the recycle list. 

nodes_in_use : natural := 0; — The number of sequence heap nodes in use. 

— Invariant: node s_in_recycle_list = length (recycle_list) <= nodes_in_use . 

— Local subprogram declarations, 
function copy_list (1 : link) return link; 

function create (len: natural; e: elements_type ; next: link) return link; 
function token return character; 

— End local subprogram declarations. 

— Constant declarations. 

is_blank: constant del imiter_array := initialize_delimiter_array ; 

-- End constant declarations. 

procedure empty (s: out sequence) is 

si: sequence; -- Default initialization gives an empty sequence, 
begin 

s : = si; 
end empty; 

procedure add(x: in t; s: in out sequence) is 
begin 

s. length := s. length + 1; 
if s. length <= block^size then 
s . element s ( s . length) := x; 
elsif s.next = null then 

s.next := create (1, (others => x) , null); 
else add(X/ s.next. all); 
end if; 
end add; 

— generic 

— with function eq(x, y: t) return boolean is <>; 
procedure generic_remove (x : in t; s: in out sequence) is 
— Remove all instances of x from s. 
ss ; sequence; -- Initialized to empty. 

local^x : t ;= x; — patch to work around compiler bug, verdix version 6.0. 
begin 

-- Begin expansion of FOREACH loop macro, 
declare 
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procedure loop_body{y: t) is 

begin if not eq(local_x, y) then add(y, ss) ; end if; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute^loop (s) / 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

-- so you must write [[x]] in the m4 source file 

-- to get [x] in the generated Ada code. 

Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define] . 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro, 
recycle ( s) ; 

s : = ss; 

end generic_remove ; 

procedure append (si, s2 ; in sequence; s: out sequence) is 
ss: sequence; -- Initialized to empty, 

begin 

-- Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(x: t) is 
begin add(x, ss) ; 
end loop_body; 

procedure execute_loop is new generi c_scan ( loop_body ) ; 
begin 

execute_loop (si) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [ [x] ] in the m4 source file 

— to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

-- or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

End expansion of FOREACH loop macro. 

-- Begin expansion of FOREACH loop macro, 
declare 
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procedure loop_body(x: t) is 
begin add(x, ss) ; 
end loop_body; 

procedure execute^loop is new generic^scan (loop^body ) ; 
begin 

execute_loop (s2) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 

— to get [x] in the generated Ada code. 

-- Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define] . 

-- The implementation requires each package to be generated by 

— a separate call to mA : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

-- An expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— End expansion of FOREACH loop macro, 
s : = ss ; 

end append; 

function fetch (s : sequence; n: natural) return t is 

begin 

if n > s. length then raise bounds_error; 
elsif n <= block_size then return s . elements (n) ; 
else return f etch ( s . next . all , n - block_size) ; 
end if; 
end fetch; 

procedure fetch (si: sequence; ia: index_array; s: out sequence) is 
ss : sequence; — Initialized to empty, 

begin 

for i in ia' range loop 

add ( fetch ( si , ia (i) ) , ss); 
end loop; 
s : = s s ; 
end fetch; 

procedure fetch (si: sequence; low, high: natural; s: out sequence) is 
-- sl[low .. high] 

ss: sequence; — Initialized to empty, 

begin 

for i in low . . high loop 
add ( fetch ( si , i) , ss); 
end loop; 
s : = s s ; 
end fetch; 

function length (s: sequence) return natural is 
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begin 

return s. length; 
end length; 

function domain (s: sequence) return natural^set is 

ns: natural_set; 
begin 

empty ( ns ) ; 

for 1 in 1 .. s. length loop 

add ( i , ns) ; 
end loop; 
return ns; 
end domain; 

— generic 

-- with function eq(x, y: t) return boolean is <>; 
function generic_member (x : t; s: sequence) return boolean is 

local_x: t := x; -- patch to work around compiler bug, verdix version 6.0. 
begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if eq(local_x, y) then raise return_f rom_f oreach ; end if; 
end loop_body; 

procedure execute^loop is new generic^scan (loop^body) ; 
begin 

execute_loop (s) ; 
except ion 

when ret urn_from_f oreach => return true; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 

-- so you must write [ [x] ] in the m4 source file 
-- to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

-- The implementation requires each package to be generated by 

— a separate call to m4 ; put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 
-- mention any index variables of the loop. 

— End expansion of FOREACH loop macro, 
return (false) ; 

end generic_member ; 

generic 

— with function eq(x, y: t) return boolean is <>; 

function gener ic_part_of ( si , s2: sequence) return boolean is 

n; natural := 0; 

-- The definition of "matches at" is nested inside "member" 
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— to provide acces 
function matches_at 
i : natu ral : = 0 ; 
begin 

while i < length ( 
— Invariant: s 
if eq (fetch (si , 
else return fal 
end loop; 
return true; 
end matches_at; 



s to the generic function 
(si, s2: sequence; n; natu 



Si) 


loop 




1[1 


. . i] = s2 [n . 


. n+i-1] 


i - 


f 1 ) , fetch ( s2, 


n + i) ) 


se; 


end if; 





parameter "eq" . 
ral) return boolean 



then i := i + 1; 



is 



begin 

while n + length (si) <= length (s2) loop 

— Invariant: si does not match s2 at positions <= n 

if matches_at ( si , s2, n + 1) then return true; 

else n := n + 1; end if; 
end loop; 
return false; 
end generic_part_of ; 



— generic 

— with function eq(x, y: t) return boolean is <>; 
function generic_equal ( si , s2 : sequence) return boolean is 

size : natural; 
begin 

if si. length = s2. length then size := si. length; 

else return false; end if; 
for i in 1 . . size loop 

if not eq(fetch(sl, i) , fetch (s2, i) ) then return false; 
end loop; 
return true; 
end generic^equal ; 



end if; 



— generic 

— with function "<"(x, y: t) return boolean is <>; 
function generic_less_than (si, s2; sequence) return boolean is 
size : natural; 
begin 



if si. length 


<= s2 . length 


then 


size := 


si . length ; 


else size 


:= s2. length; 


: end 


if ; 




for i in 1 . . 


size loop 








if fetch (si , i ) < 


fetch ( s2 , i) 


i the 


n return 


true; 


elsif fetch(s2, i 


) < fetch (si < 


. i) 


then return false; 



end if; 

end loop; 

return si. length < s2. length; 
end generic_less_than; 



— generic 

— with function "<"(x, y: t 

— with function eq(x, y: t) 



return boolean is <>; 
return boolean is <>; 
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function generic_les s_than_or_equal { si , s2 : sequence) return boolean is 

function It is new generic_less_than; 
function equal is new generic_equal (eq) ; 
begin 

return It {si, s2) or else equal (si, s2); 
end generic_less_than_or_equal ; 

-- generic 

— with function "<"(x, y: t) return boolean is <>; 

function generic_greater_than ( si , s2 : sequence) return boolean is 

function It IS new generic_less_than; 
begin 

return lt(s2, si); 
end generic_greater_than ; 

— generic 

— with function "<"(x, y: t) return boolean is <>; 

— with function eq(x, y: t) return boolean is <>; 

function generic_greater_or_equal ( si , s2 : sequence) return boolean is 
function It is new generic_less_than; 
function equal is new generic_equal (eq ) ; 
begin 

return lt(s2, si) or else equal(sl, s2); 
end generic_greater_or_equal / 

— generic 

— with function eq(x, y: t) return boolean is <>; 

function generic_subsequence ( s 1 , s2: sequence) return boolean is 

il, i2 : natural := 0 ; 
begin 

while il < si. length loop 

— Invariant: subsequence ( si [ 1 .. il], s2[l .. i2]). 

-- Invariant: il <= si. length & i2 <= s2. length. 

if i2 = s2. length then return false; else i2 := i2 + 1; end if; 
if eq(fetch(sl, il + 1), fetch (s2, i2) ) then il := il + 1; end if; 
end loop; 
return true; 

end generic_subsequence; 

-- The above alogrithm can be speeded up by doing parallel 

— scans of si and s2, eliminating the use of fetch. 

— This was not done because it is complicated 

— and because we do not expect this to be a frequent operation. 

— generic 



— 


with function 


" < " ( X , y : t ) 


return boolean is <>; 


— 


with function 


successor (x ; 


t) return t ; 


-- 


ALL (x y : t : : 


X < y => successor(x) <= y) 


procedure generic i 


nterval (xl, 


x2 : t; s: out sequence) 


ss 


: sequence; — 


Initialized 


to empty. 


y : 


t : = X 1 ; 







begin 
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Invariant: xl <= y . 



while not (x2 < y) loop -- 
add (y , ss) ; 
y := successor (y) / 
end loop; 
s : = s s ; 

end generic_interval ; 

— generic 

— type et is private; 

— type St is private; — st = sequence{et) 

-- with function f(x: et) return t; 

with function length (s: st) return natural is <>; 

— with function fetch (s: st; n: natural) return et is <>; 
procedure generic_apply ( si : st; s2 : out sequence) is 

ss : sequence; -- Initialized to empty, 

begin 

for 1 in 1 . . length (si) loop 

add ( f ( fetch ( si , i) ) , ss) ; 
end loop; 
s 2 : = s s ; 

end generi c_apply ; 

— generic 

— with function f (x, y: t) return t; 

— identity: t; 

function generic_reduce ( s : sequence) return t is 
x: t := identity; 
begin 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 
begin x : = f (y , x) ; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body ) ; 
begin 

execute_loop (s) ; 
end; 

— LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define]. 

— The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro, 
return x; 
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end generic_reduce ; 



— generic 

— with function f(x, y: t) return t; 

function gener ic_reduce 1 ( s : sequence) return t is 

X : t; 

1 : natural : = 1 ; 
begin 

if s. length = 0 then raise empty_reduction_undef ined ; end if; 

X : = f et ch ( s , 1 ) ; 

— Begin expansion of FOREACH loop macro, 
declare 

procedure loop_body(y: t) is 

begin if i > 1 then x := f (y, x) ; end if; i := i + 1; 
end loop_body; 

procedure execute_loop is new generic_scan (loop_body) ; 
begin 

execute_loop (s) ; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 

— so you must write [[x]] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define] . 

-- The implementation requires each package to be generated by 

— a separate call to m4 : put each package in a separate file. 

-- Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro, 
return x; 

end generic_reduce 1 ; 

procedure gene ri c^scan ( s : sequence) is 

t: sequence := s; 
begin 

while t.next /= null loop 

for i in 1 . . block_size loop 

generate (t .elements (i) ) ; 
end loop; 
t : = t . next . all ; 
end loop; 

for i in 1 . . t. length loop 

generate (t .elements (i) ) ; 
end loop; 
end generi c_scan ; 

— System functions and local subprograms. 
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procedure assign (x: out sequence; y: in sequence) is 
begin 

X . length := y. length; 

X. elements := y. elements; 
x.next := copy_l ist ( y . next ) ; 
end assign; 

function copy_list(l: link) return link is 
begin 

if 1 = null then return 1; 

else return create (1 . length, 1. elements, copy_list (1 . next) ) ; 
end if; 

end copy_list; 

function create (len: natural; e: element s_type ; next: link) return link is 
1: link; 
begin 

nodes_in_use := nodes_in_use + 1; 
if recycle_list = null then 

return new sequence' (len, e, next); 
else 1 := recycle_list ; 

recycle_list := recycle_list . next ; 

nodes_in_recy cle_li St : = nodes_in_recycle_list - 1; 

1. length := len; 1. elements := e; l.next := next; 
return 1; 
end if; 
end create; 

procedure recycle (s: in sequence) is 
1 : 1 ink : = s . next; 
head, temp: link; 

procedure free is new unchecked_deallocation (sequence, link); 
begin 

while 1 /= null loop 

head := 1; 1 := l.next; 

nodes_in_use := nodes_in_use - 1; 
if nodes_in_recycle_list < nodes_in_use then 
temp := recycle_l ist ; 
recycle_list := head; 
recycle^list . next := temp; 

nodes_in_recycle_list := nodes_in_recycle_list + 1; 
else free (head); 
end if; 
end loop; 
end recycle; 

— generic 

— with procedure input (item: out t) is <>; 
procedure generi c_input ( item : out sequence) is 

X : t ; 

s: sequence; -- Working copy of the result, initialized to empty. 
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begin 

if token /= ascii . l^bracket then raise data_error; end if; 
skip_char; — Pass over the opening left bracket, 
while token /- a scii . r_bracket loop 

input (x) ; -- Read and pass over the next element of the sequence. 

add(x, s); — Add the element to the sequence. 

if token = then skip_char; — Another element should follow. 

elsif token i- asci i . r^bracket then raise data_error; 

— if there is no comma we should be at the end of the sequence, 
end 1 f ; 

end loop; — Now the closing right bracket is the lookahead character, 
sk ip_char ; 
item := s; 
exception 

when others => raise data^error; 
end generi c_input ; 

— generic 

with procedure input (item: out t) is <>; 
procedure generi c_f i le^input ( item : out sequence; file; in file_type) is 
procedure get_sequence is new generi c_input ; 
begin 

set_input ( f i le ) ; — Connect the lookahead stream to the file. 

get_sequence (item) ; 

set_input ( st andard_input ) ; — Restore the standard input file, 

end gene ric_f ile_input ; 

function token return character is 

— Blank is a constant array, see top of package body, 
begin 

-- Advance the lookahead stream to a non-blank character. 

while is_blank (peek) loop skip_char; end loop; 

-- Return the character without removing it from the stream, 
return peek; 
end token; 

-- generic 

with procedure put (item: in t) is <>; 
procedure generic_put ( item : in sequence) is 
begin 

put (ascii . l_bracket ) ; 

if length (item) >= 1 then put ( fetch ( item, 1)); end if; 
for 1 in 2 . . length (item) loop 

put (","); 

put ( fetch ( item , i) ) ; 
end loop; 

put (ascii , r_bracket ) ; 
end generic^put ; 

— generic 

with procedure put (file: in file_type; item: in t) is <>; 
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procedure generic_f rle_put (f ile : in file__type; item: in sequence) is 

begin 

put (file, ascii . l_bracket) ; 

if length (item) >= 1 then put (file, fetch (item, 1)); end if; 
for i in 2 . . length (item) loop 

put (file, ", "); 

put (file, fetch (item, i) ) ; 
end loop; 

put (file, ascii . r_bracket) ; 
end generic_f ile_put ; 
end generic_sequence_pkg; 
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APPENDIX O. GENERIC STACK PACKAGE 



— stacks. a 



-- 3Source: /tmp_mnt/n/gemini /work/bay ram/AYACC/parser/RCS/stacks . a, v $ 
— $Revision: 1.2 3 — 3Date: 1991/07/31 04:28:41 5 — 3Author: bayram 3 

with lists; — t Implementation uses lists. (private) 



generic 

type elem_type is private; — | Component element type, 
package stack_pkg is 



Overview : 

This package provides the stack abstract data type. Element type is 
a generic formal parameter to the package. There are no explicit 
bounds on the number of objects that can be pushed onto a given stack. 
All standard stack operations are provided. 



The following is a complete list 
in which they appear in the spec, 
by (n) , where n is the number of 

Constructors : 
create 
push 
pop (2) 
copy 

Query Operations: 
top 
size 

is_empty 
replace_top 
reverse_stack 
Heap Management : 
destroy 



of operations, written in the order 
Overloaded subprograms are followed 
subprograms of that name. 



— I Notes : 
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type stack is private; 



— I The stack abstract data type. 



- Exceptions: 

uninitialized_stack : exception; 

— I Raised on attempt to manipulate an uninitialized stack object. 

— I The initialization operations are create and copy. 

empty_stack: exception; 

— 1 Raised by some operations when empty. 



- Constructors: 



function create 
return stack; 



— 1 Effects: 

— 1 Return the empty stack. 

procedure push(s: in out stack; 

e: elem_type) ; 

— 1 Raises: uninit ialized_stack 

— I Effects: 

-“I Push e onto the top of s. 

-- I Raises uninitialized_stack iff s has not been initialized, 
procedure pop(s: in out stack); 



— 1 Raises: empty_stack, uninitialized_stack 

— I Effects : 

— 1 Pops the top element from s, and throws it away. 

— I Raises empty_stack iff s is empty. 

— I Raises uninitialized stack iff s has not been initialized. 



procedure pop(s: in out stack; 
e: out elem_type) ; 



Raises: empty_stack, uninitialized_stack 
Effects : 

Pops the top element from s, returns it as the e parameter. 
Raises empty_stack iff s is empty. 

Raises uninitialized stack iff s has not been initialized. 
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procedure replace_top (e : in elem_type; 
s: in out stack); 



Raises: empty_stack, uninitialized_stack 
Effects : 

replaces the top of the stack with the next e, . . 

.. returns s as the modified satck. 

Raises empty_stack iff s is empty. 

Raises uninitialized stack iff s has not been initialized. 



procedure reverse_stack (s : in out stack); 



Raises : empty_stack, unin it ialized_s tack 
Effects : 

reverses the order of the elements un the stack s, . . 

.. returns s as the modified satck. 

Raises empty_stack iff s is empty. 

Raises uninitialized stack iff s has not been initialized. 



function copy(s: stack) 
return stack; 



Raises: uninitialized_stack 
Return a copy of s. 

Stack assignment and passing stacks as subprogram parameters 
result in the sharing of a single stack value by two stack 
objects; changes to one will be visible through the others, 
copy can be used to prevent this sharing. 

Raises uninitialized stack iff s has not been initialized. 



— Queries: 

function top(s: stack) 
return elem_type; 

— I Raises: empty_stack, uninit ialized_stack 
— I Effects: 

— ! Return the element on the top of s. Raises empty_stack iff s is 
— ! empty. 

— I Raises uninitialized stack iff s has not been initialized. 
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function size(s: stack) 
return natural; 

— I Raises: uninit ialized^stack 

— I Effects: 

--| Return the current number of elements in s. 

— I Raises uninitialized_stack iff s has not been initialized. 

function is_empty(s: stack) 
return boolean; 

— I Raises: uninitialized_stack 
--| Effects: 

— i Return true iff s is empty. 

-- I Raises uninit ialized_stack iff s has not been initialized. 



— Heap Management : 

procedure destroy (s: in out stack); 

— I Effects: 

— I Return the space consumed by s to the heap. No effect if s is 
— i uninitialized. In any case, leaves s in uninitialized state. 



private 

package elem_list_pkg is new lists (elem_type) ; 
subtype elem_list is elem_list_pkg . list ; 

type stack_rec is 
record 

size: natural := 0; 

elts: elem_list := elem_list_pkg . create; 
end record; 



type stack is access stack_rec; 



Let an instance of the representation type, r, be denoted by the 
pair, <size, elts>. Dot selection is used to refer to these 
components . 



Rep 



resentation Invariants: 
r /- null 

elem_list_pkg . length (r . elts) 



r . size . 
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— I Abstraction Function: 

— I A(<size, elem_list_pkg . create>) = stack_pkg . create . 

— I A(<size, elem_list_pkg . attach (e, 1)>) = push (A (<size, 1>), e) . 

end stack_pkg; 



— stack b.a 



-- SSource: /tmp_mnt /n/gemini/work/bayram/AYACC/parser/RCS/stack_b . a, v $ 
— $Revision: 1.2 $ — $Date: 1991/07/31 04:28:39 $ — $Author: bayram $ 

with unchecked deallocation; 



package body stack_pkg is 



Overviev; : 

Implementation scheme is totally described by the statements of the 
representation invariants and abstraction function that appears in 
the package specification. The implementation is so trivial that 
further documentation is unnecessary. 



use elem_list_pkg; 



— Constructors: 

function create 

return stack is 
begin 

return new stack_rec ’ (size => 0, elts => create); 
end create; 

procedure push(s: in out stack; 

e: elem_type) is 

begin 

s.size := s.size + 1; 
s.elts := attach(e, s.elts); 
exception 

when constraint_error => 

raise uninitialized_stack; 
end push; 



procedure pop(s: in out stack) is 
begin 

DeleteHead (s . elts) ; 
s.size := s.size - 1; 
exception 

when EmptyList => 

raise empty_stack; 
when constraint_error => 

raise uninit ialized_stack; 
end pop; 

procedure pop(s: in out stack; 

e: out elem_type) is 

begin 

e := FirstValue (s .elts) ; 
DeleteHead (s . elts) ; 
s.size := s.size - 1; 
exception 

when EmptyList => 

raise empty_stack; 
when constraint_error => 

raise uninitialized_stack; 
end pop; 



procedure replace_top (e : in elem_type; 
s: in out stack) is 

temp_elem: elem_type; 
begin 

pop(s, temp_elem) ; 
push (s, e) ; 
push(s, temp_elem) ; 
exception 

when EmptyList => 

raise empty_stack; 
when constraint_error => 

raise uninitialized_stack; 
end replace_top; 



procedure reverse_stack (s : in out stack) is 
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create; 



temp : stack := 
begin 

while not is_empty(s) loop 
push (temp, top (s) ) ; 
pop (s) ; 

end loop; 
s := copy (temp) ; 
destroy (temp) ; 
exception 

when EmptyList => 

raise empty_stack; 
when constraint^error => 

raise uninitialized_stack; 
end reverse_stack; 



function copy(s: stack) 
return stack is 
begin 

if s = null then raise uninitialized_stack; end if 

return new stack_rec ' (size => s.size, 
elts => copy (s . elts) ) ; 
end; 



— Queries: 

function top(s: stack) 
return elem_type is 
begin 

return FirstValue (s . elts) ; 
exception 

when EmptyList => 
raise empty_stack; 
when const raint__error => 

raise uninitialized_stack; 
end top; 

function size(s: stack) 
return natural is 
begin 

return s.size; 
exception 

when constraint error => 



277 



raise uninitialized_stack; 
end size; 

function is_empty(s: stack) 
return boolean is 
begin 

return s.size = 0/ 
exception 

when constraint_error => 
raise uninit ialized_stack; 
end is_empty; 



-- Heap Management: 

procedure destroy (s: in out stack) is 
procedure free__stack is 
new unchecked_deallocation (stack_rec, stack); 
begin 

destroy (s , elts) ; 
f ree_stack (s) ; 
exception 

when constraint_error => — stack is null 

return; 
end destroy; 

end stack_pkg; 
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APPENDIX P. GENERIC LIST PACKAGE 



— 1 ist s . a 



generic 

type ItemType is private; 



•| This is the data being manipulated. 



with function Equal { X, Y : in ItemType) return boolean is 

— I This allows the user to define 
-- I equality on ItemType. For instance 
if ItemType is an abstract type 
then equality is defined in terms of 
the abstract type. If this function 
is not provided equality defaults to 



package Lists is 



This package provides singly linked lists with elements of type 
ItemType, where ItemType is specified by a generic parameter. 

Overview 

When this package is instantiated, it provides a linked list type for 
lists of objects of type ItemType, which can be any desired type. A 
complete set of operations for manipulation, and releasing 
those lists is also provided. For instance, to make lists of strings, 
all that is necessary is: 

type StringType is string { 1 .. 10) ; 

package Str_List is new List s ( St ringType ) ; use Str_List; 

L : L i s t ; 

S : StringType ; 

Then to add a string S, to the list L, all that is necessary is 

L := Create; 

Attach { S, L) ; 



This package provides basic list operations. 



Attach 



append an object to an object, an object to a list, 
or a list to an object, or a list to a list. 
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Copy 

CopyDeep 

Create 

DeleteHead 

Deleteltem 

Delete Items 

Destroy 

De St royDeep 

Equal 

FirstValue 

Forward 

I sInList 

IsEmpty 

LastValue 

Length 

MakeList 

MakeList Iter 

More 

Next 

ReplaceHead 
ReplaceTai 1 
Tail 

CellValue 



copy a list using := on elements 

copy a list by copying the elements using a copy 
operation provided by the user 
Creates an empty list 
removes the head of a list 

delete the first occurrence of an element from a list 
delete all occurrences of an element from a list 
remove a list 

destroy a list as well as the elements in that list 
are two lists equal 

get the information from the first element of a list 
advances an iterator 

determines whether a given element is in a given list 
returns true if the list is empty 
return the last value of a list 
Returns the length of a list 

this takes a single element and returns a list 
prepares for an iteration over a list 
are there any more items in the list 
get the next item in a list 

replace the information at the head of the list 
replace the tail of a list with a new list 
get the tail of a list 

this takes an iterator and returns the value of the element 
whose position the iterator holds 



N/A: Effects, Requires, Modifies, and Raises. 
Notes 



Types 



type List is private; 

type Listiter is private; 



I Exceptions 

I 



CircularList lexception; 



EmptyList : exception; 



ItemNotPresent : exception; 



Raised if an attemp is made to 
create a circular list. This 
results when a list is attempted 
to be attached to itself. 

Raised if an attemp is made to 
manipulate an empty list. 

Raised if an attempt is made to 
remove an element from a list in 
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— 1 which It does not exist. 



NoMore 



rexception; -- I Raised if an attemp is made to 

— I get the next element from a list 
--| after iteration is complete. 



— I Operations 

1 



procedure Attach ( 
List 1 : 
List2 : 

) ; 



in out List; 
in List 



--| appends List2 to Listl 
--| The list being appended to. 
— I The list being appended. 



-- I Raises 

-- I CircularList 



Effect s 

Appends Listl to List2 . This makes the next field of the last element 
of Listl refer to List2. This can possibly change the value of Listl 
if Listl is an empty list. This causes sharing of lists. Thus if 
user Destroys Listl then List2 will be a dangling reference. 

This procedure raises CircularList if Listl equals List2 . If it is 
necessary to Attach a list to itself first make a copy of the list and 
attach the copy. 



Modifies 

Changes the next field of the last element in Listl to be List2. 



function Attach ( -- | 

”1 

Elementl: in ItemType; | 

Element2: in ItemType --| 

) return List; 

— I Effect s 

-- I This creates a list containing the two elements in the order 

— I specified. 



Creates a new list containing the two 
Element s . 

This will be first element in list. 
This will be second element in list. 



procedure Attach ( 

L: in out List; 

Element : in ItemType 

) ; 



— I List L is appended with Element. 

— I List being appended to. 

— I This will be last element in 1 ist . 
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Effect s 

Appends Element onto the end of the list L. If L is empty then this 
may change the value of L. 



Modifies 

This appends List L with Element by changing the next field in List. 



procedure Attach ( 

Element: in ItemType; 

L: in out List 



) ; 



I Makes Element first item in list L. 

I This will be the first element in list. 
I The List which Element is being 
I prepended to. 



— I Effects 

--| This prepends list L with Element. 



-- I Modifies 

— I This modifies the list L. 



function Attach ( 

Listl : in List; 

List2: in List 

) return List; 



-- 1 attaches two lists 
--| first list 
-- I second list 



— I Raises 

— I CircularList 



Effects 

This returns a list which is Listl attached to List2 . If it is desired 
to make Listl be the new attached list the following ada code should be 
used . 



Listl := Attach (Listl 
This procedure raises 
necessary to Attach a 
attach the copy. 



, List2); 

CircularList if Listl equals List2 . If it is 
list to itself first make a copy of the list and 



function Attach ( 

Element: in ItemType; 

L: in List 

) return List; 



— 1 prepends an element onto a list 

— I element being prepended to list 

— I List which element is being added 

— I to 



— 1 Effects 

— I Returns a new list which is headed by Element and followed by L. 
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function Attach ( 

L : in 

Element : in 
) return List; 



— I Adds an element to the end of a list 
List; --| The list which element is being added to. 

ItemType -- | The element being added to the end of 
--| the list. 



— I Effects 

— I Returns a new list which is L followed by Element. 



I returns a copy of listl 
I list being copied 

— I Effects 

— I Returns a copy of L. 



function Copy ( 

L: in List 
) return List; 



generic 

with function Copy ( I : in ItemType) return ItemType; 



function CopyDeep ( — | returns a copy of list using a user supplied 

— I copy function. This is helpful if the type 
— I of a list is an abstract data type. 

L: in List — | List being copied. 

) return List; 

-- I Effects 

— I This produces a new list whose elements have been duplicated using 

— I the Copy function provided by the user. 



function Create — | Returns an empty List 

return List; 



procedure DeleteHead ( 

L: in out List 



) ; 



— I Remove the head element from a list. 

— I The list whose head is being removed. 



— I RAISES 

— I EmpryList 

— I 
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EFFECTS 



This will return the space occupied by 
to the heap. If sharing exists between 
could leave a dangling reference. If L 
raised . 



the first element in the list 
lists this procedure 
is empty EmptyList will be 



procedure Deleteltem ( — | remove the first occurrence of Element 

— I from L 

L: in out List; — | list element is being removed from 

Element: in ItemType — 1 element being removed 

) ; 

— I EFFECTS 

— I Removes the first element of the list equal to Element. If there is 

— I not an element equal to Element than ItemNotPresent is raised. 

-“I MODIFIES 

— I This operation is destructive, it returns the storage occupied by 

— I the elements being deleted. 



function Deleteltem ( 


— 


L : in 


List; — 


Element : in 


ItemType — 


) return List; 




— 1 EFFECTS 





remove the first occurrence of Element 
from L 

list element is being removed from 
element being removed 



— I This returns the List L with the first occurrence of Element removed. 



function Deleteltems ( — | 

— I 

L: in List; — | 

Element : in ItemType — | 

) return List; 

— I EFFECTS 

— I This function returns a copy of the list L which has all elements which 

— I have value Element removed. 



remove all occurrences of Element 
from L. 

The List element is being removed from 
element being removed 



procedure Deleteltems ( — | 

--I 

L: in out List; — | 

Element: in ItemType — | 



remove all occurrences of Element 
from L. 

The List element is being removed from 
element being removed 
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) ; 

— I EFFECTS 

— I This procedure removes all occurrences of Element from the List L. This 

— I is a destructive procedure. 



procedure Destroy ( 

L: in out List 



) ; 



— I removes the list 

— I the list being removed 



— I Effects 

— 1 This returns to the heap all the storage that a list occupies. Keep in 

— I mind if there exists sharing between lists then this operation can leave 

— I dangling references. 



generic 

with procedure Dispose (I :in out ItemType); 



procedure DestroyDeep 
L :in out List 

) ; 



--| Destroy a list as well as all objects which 
— [ comprise an element of the list. 



OVERVIEW 

This procedure is used to destroy a list and all the objects contained 
in an element of the list. For example if L is a list of lists 
then destroy L does not destroy the lists which are elements of L. 
DestroyDeep will now destroy L and all the objects in the elements of L. 

The produce Dispose is a procedure which will destroy the objects which 
comprise an element of a list. For example if package L was a list 
of lists then Dispose for L would be the Destroy of list type package L was 
instantiated with. 



REQUIRES 

This procedure requires no sharing between elements of lists. 

For example if L_int is a list of integers and L_of_L_int is a list 
of lists of integers and two elements of L_of_L_int have the same value 
then doing a DestroyDeep will cause an access violation to be raised. 
The best way to avoid this is not to have sharing between list elements 
or use copy functions when adding to the list of lists. 



function FirstValue ( 

L: in List 

— 1 returned 



— I returns the contents of the first record of the 

— I list 

— I the list whose first element is being 
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) return ItemType; 



— I Raises 

— I EmptyList 



Effects 

This returns the Item in the first position in the list. If the list 
is empty EmptyList is raised. 



procedure Forward ( 

I :in out Listiter 

) ; 



— I Advances the iterator. 

— I The iterator. 



OVERVIEW 

This procedure can be used in conjunction with Cell to iterate over a list. 
This is in addition to Next. Instead of writing 

I : Listiter; 

L :List; 

V ; List_Element_Type; 

I := MakeList Iter (L) ; 
while More (I) loop 
Next (I, V) ; 

Print (V) ; 
end loop; 

One can write 
I := MakeList Iter (L) ; 
while More (I) loop 

Print (Cell (I)); 

Forward (I) ; 
end loop; 



function IsEmpty( — | Checks if a list is empty. 

L: in List --| List being checked. 

) return boolean; 



function IsInList( 

L : in 

Element : in 
) return boolean; 



— I Checks if element is an element of 
— I list. 

List; — I list being scanned for element 

ItemType — | element being searched for 
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— I Ef feet s 

— I Walks down the list L looking for an element whose value is Element. 



function LastValue ( 
L: in List 
) return ItemType; 



— 1 Returns the contents of the last record of 
-- 1 the list . 

— I The list whose first element is being 

— I returned . 



Raises 

EmptyList 



Effects 

Returns the last element in a list, 
raised . 



If the list is empty EmptyList is 



function Length ( 

L: in List 

) return integer; 



— I count the number of elements on a list 
-“1 list whose length is being computed 



function MakeList ( — | This takes in an element and returns a List. 

E :in ItemType 

) return List; 



function MakeList Iter ( 



L: in List 
) return Listiter; 



— I Sets a variable to point to the head 

— I of the list. This will be used to 

— I prepare for iteration over a list. 

— I The list being iterated over. 



This prepares a user for iteration operation over a list. The iterater is 
an operation which returns successive elements of the list on successive 
calls to the iterator. There needs to be a mechanism which marks the 
position in the list, so on successive calls to the Next operation the 
next item in the list can be returned. This is the function of the 
MakeListIter and the type Listiter. Makelter just sets the Iter to the 
the beginning of the list. On subsequent calls to Next the Iter 
is updated with each call. 
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function More ( 



--| Returns true if there are more elements in 
-- I the and false if there aren’t any more 
— I the in the list. 

L: in Listiter — | List being checked for elements. 

) return boolean; 



procedure Next ( 



Place: in out Listiter; 

Info: out ItemType 



This is the iterator operation. Given 
a Listiter in the list it returns the 
current item and updates the Listiter. 
If Listiter is at the end of the list, 
More returns false otherwise it 
returns true. 

The Iter which marks the position in 
the list. 

The element being returned. 



) ; 



— I The iterators subprograms MakeList Iter , More, and Next should be used 

— I in the following way: 

— I L : List ; 

— I Place: Listiter; 

— I Info: Some Type; 



Place := MakeList Iter (L) ; 

while ( More (Place) ) loop 
Next (Place, Info) ; 
process each element of list L; 
end loop; 



procedure ReplaceHead ( -- | 

— I 

L: in out List; -- | 

Info: in ItemType — | 

) ; 

— I Raises 

— I EmptyList 

— I Ef feet s 

— I Replaces the information in the first element in the list. Raises 

— 1 EmptyList if the list is empty. 



Replace the Item at the head of the list 
with the parameter Item. 

The list being modified. 

The information being entered. 
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procedure ReplaceTail ( 



) ; 



-- I Replace the Tail of a list 
— 1 with a new list. 

L: in out List; --| List whose Tail is replaced. 

NewTail: in List — | The list which will become the 

-- I tail of Oldlist. 



Raises 

EmptyList 



Effects 
Replaces 
is being 



the tail 
replaced 



of 

is 



a list with a new 
null EmptyList is 



list . 
raised 



If the 



list whose tail 



function Tail( | returns the tail of a list L 

L: in List — | the list whose tail is being returned 

) return List; 



Raises 

EmptyList 



Effects 

Returns a list 
L is empty. If 
list. 



which is the tail of the list L. Raises EmptyList 
L only has one element then Tail returns the Empty 



if 



function CellValue ( — | Return the value of the element where the iterator is 
-- I positioned. 

I : in List Iter 

) return ItemType; 

— I OVERVIEW 

— 1 This returns the value of the element at the position of the iterator. 

— I This is used in conjunction with Forward. 



function Equal ( — | compares listl and list2 for equality 

Listl: in List; — | first list 

List2 : in List — | second list 

) return boolean; 

— I Ef feet s 

— I Returns true if for all elements of Listl the corresponding element 
-- 1 of List2 has the same value. This function uses the Equal operation 

— I provided by the user. If one is not provided then = is used. 
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— I pointer added by this package 

— I in order to make a list 



private 

type Cell; 

type List is access Cell; 



type Cell is — | Cell for the lists being created 

record 

Info: ItemType; 

Next : List ; 
end record; 



type Listiter is new List; 



— I This prevents Lists being assigned to 
--| iterators and vice versa 



end Lists; 



— list b.a 



with unchecked_deallocat ion; 
package body Lists is 

procedure Free is new unchecked_deallocation (Cell, List); 



function Last (L: in List) return List is 

Place__In_L: List; 

Temp_Place_In_L : List; 

--1 Link down the list L and return the pointer to the last element 
— I of L. If L is null raise the EmptyList exception. 

begin 

if L = null then 

raise EmptyList; 

else 



— I Link down L saving the pointer to the previous element in 
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— I Temp_Place_In_L . After the last iteration Temp_Place_In_L 
— I points to the last element in the list. 

Place_In_L := L; 

while Place_In_L /= null loop 

Temp_Place_In_L := Place_In_L; 

Place_In_L := Place_In_L . Next ; 
end loop; 

return Temp_Place_In_L; 
end if; 
end Last; 



procedure Attach (Listl: in out List; 

List2: in List ) is 

EndOfListl : List; 



Attach List2 to Listl. 

If Listl is null return List2 
If Listl equals List2 then raise 
Otherwise get the pointer to the 
its Next field to be List2 . 



CircularList 

last element of Listl and change 



begin 

if Listl = null then 
Listl : = List2; 

return ; 

elsif Listl = List2 then 
raise CircularList; 

else 

EndOfListl := Last (Listl); 
EndOfListl .Next := List2; 
end if; 
end Attach; 



procedure Attach (L: in out List; 

Element : in ItemType ) is 

NewEnd: List; 

— I Create a list containing Element and attach it to the end of L 
begin 

NewEnd := new Cell’ (Info => Element, Next => null); 

Attach (L, NewEnd) ; 

end ; 
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function Attach (Elementl : in ItemType; 

Element2 : in ItemType ) return List is 
NewList : List; 

— I Create a new list containing the information in Elementl and 

— I attach Element2 to that list. 

begin 

NewList := new Cell* (Info => Elementl, Next => null); 

Attach (NewList, Element2) ; 
return NewList; 

end; 



procedure Attach (Element: in ItemType; 

L: in out List ) is 

— I Create a new cell whose information is Element and whose Next 

— I field is the list L. This prepends Element to the List L. 



begin 

L := new Cell* (Info => Element, Next => L) ; 

end; 



function Attach ( Listl : in 

List2 : in 



Li st ; 

List ) return List is 



Last_Of__Listl : List; 
begin 

if Listl = null then 
return List2; 
elsif Listl = List2 then 
raise CircularList ; 

else 

Last_Of_Listl : = Last (Listl); 
Last_Of_List 1 . Next := List2; 
return Listl; 
end if; 
end Attach; 



function Attach ( L: in 

Element: in 



Li st ; 

ItemType ) return List is 



NewEnd: List; 

Last_Of__L: List; 

-“1 Create a list called NewEnd and attach it to the end of L. 

— 1 If L is null return NewEnd 

--| Otherwise get the last element in L and make its Next field 

— I NewEnd . 

begin 

NewEnd := new Cell' (Info => Element, Next => null); 
if L = null then 

return NewEnd; 

else 

Last_Of_L := Last (L) ; 

Last_Of_L . Next := NewEnd; 
return L; 
end if; 
end Attach; 



function Attach (Element: in ItemType; 

L: in List ) return List is 

begin 

return (new Cell’ (Info => Element, Next => L) ) ; 
end Attach; 



function Copy (L; in List) return List is 

— I If L is null return null 

— I Otherwise recursively copy the list by first copying the information 

— I at the head of the list and then making the Next field point to 
--| a copy of the tail of the list. 

begin 

if L = null then 
return null; 
else 

return new Cell' (Info => L.Info, Next => Copy (L.Next)); 

end if; 
end Copy; 



function CopyDeep (L: in List) return List is 



If L is null then return null. 

Otherwise copy the first element of the list into the head of the 
new list and copy the tail of the list recursively using CopyDeep. 



begin 

if L = null then 
return null; 
else 

return new Cell ’ ( Info => Copy (L.Info), Next => CopyDeep (L . Next )) ; 

end if; 
end CopyDeep; 



function Create return List is 
— I Return the empty list, 
begin 

return null; 
end Create; 



procedure DeleteHead (L: in out List) is 

TempList: List; 

— 1 Remove the element of the head of the list and return it to the heap. 

— I If L is null EmptyList . 

-- I Otherwise save the Next field of the first element, remove the first 

— I element and then assign to L the Next field of the first element. 

begin 

if L = null then 

raise EmptyList; 

else 

TempList := L.Next; 

Free (L) ; 

L := TempList; 
end if; 

end DeleteHead; 



I remove the first occurrence of Element 
I from L 

I list element is being removed from 
I element being removed 

) return List is 
I :List; 

Result :List; 



function Deleteltem( — 

L: in List; — 

Element : in ItemType — 
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Found 



rboolean := false; 



begin 



ALGORITHM 

Attach all elements of L to Result except the first element in L 
whose value is Element. If the current element pointed to by I 
is not equal to element or the element being skipped was found 
then attach the current element to Result. 



I := L; 

while (I /= null) loop 

if (not Equal (I. Info, Element)) or (Found) then 
Attach (Result, I. Info) / 

else 

Found := true; 
end if; 

I : = I . Next ; 
end loop; 
return Result; 
end Deleteltem; 



function Deleteltems ( 

L; in List; 

Element : in ItemType 

) return List is 

I .’List; 

Result :List; 
begin 

— 1 ALGORITHM 



— I remove all occurrences of Element 

— I from L . 

— I The List element is being removed from 

— I element being removed 



— I Walk over the list L and if the current element does not equal 

— I Element then attach it to the list to be returned. 



I := L; 

while I /= null loop 

if not Equal (I. Info, Element) then 
Attach (Result, I. Info) ; 
end if; 

I := I. Next; 
end loop; 
return Result; 
end Deleteltems; 



procedure Deleteltem (L: in out List; 

Element: in ItemType ) is 



Temp_L :List; 



295 



--| Remove the first element in the list with the value Element. 

— I If the first element of the list is equal to element then 

— I remove it. Otherwise, recurse on the tail of the list. 



begin 

if Equal (L . Inf o. Element) then 
DeleteHead { L) ; 

else 

Deleteltem (L . Next , Element); 
e nd i f / 

end Deleteltem; 



procedure Deleteltems (L: in out List; 

Element: in ItemType ) is 

Place_In_L :List; — i Current place in L. 

Last_Place_In_L :List; — | Last place in L. 

Temp_Place_In_L :List; — | Holds a place in L to be removed. 

— I Walk over the list removing all elements with the value Element, 
begin 

Place_In_L := L; 

Last_Place_In_L := null; 
while (Place_In_L /= null) loop 

— 1 Found an element equal to Element 
if Equal (Place_In_L . Inf o, Element) then 

— I If Last_Place_In_L is null then we are at first element 
— I in L . 

if Last_Place_In_L = null then 

Temp_Place_In_L := Place_In_L; 

L := Place_In_L . Next ; 

el se 

Temp_Place_In_L := Place_In_L; 

— I Relink the list Last's Next gets Place's Next 

Last_Place_In_L . Next := Place_In_L . Next ; 
end if; 

— I Move Place_In_L to the next position in the list. 

— I Free the element. 

— I Do not update the last element in the list it remains the 
— I same . 

Place_In_L := Place_In_L . Next ; 

Free ( Temp_Place_In_L) ; 

else 

— I Update the last place in L and the place in L. 
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Last_Place_In_L := Place_In_L; 

Place_In_L := Place__In_L . Next ; 
end if; 
end loop; 

— I If we have not found an element raise an exception, 
end Deleteltems; 



procedure Destroy (L: in out List) is 

Place_In_L: List; 

HoldPlace : List; 

— I Walk down the list removing all the elements and set the list to 
-“I the empty list. 

begin 

Place_In_L := L; 

while Place__In_L /= null loop 
HoldPlace := Place_In_L; 

Place_In_L := Place_In_L . Next ; 

Free (HoldPlace); 
end loop; 

L := null; 
end Destroy; 



procedure DestroyDeep (L: in out List) is 

Place_In_L: List; 

HoldPlace: List; 

— I Walk down the list removing all the elements and set the list to 
-- I the empty list. 

begin 

Place_In__L := L; 
while Place_In_L /= null loop 
HoldPlace := Place_In_L; 

Place_In_L := Place_In_L . Next ; 

Dispose { HoldPlace . Inf o) ; 

Free (HoldPlace) ; 
end loop; 

L := null; 
end DestroyDeep; 
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function FirstValue (L: in List) return ItemType is 

— I Return the first value in the list. 

begin 

if L = null then 
raise EmptyList; 
else 

return (L.Info); 
end if; 

end FirstValue; 



procedure Forward (I: in out Listiter) is 

— 1 Return the pointer to the next member of the list. 

begin 

if I = null then 
raise NoMore; 

else 

I := Listiter (I .Next) ; 
end if; 
end Forward; 



function IsInList (L: in List; 

Element: in ItemType ) return boolean is 

Place_In_L: List; 

— I Check if Element is in L. If it is return true otherwise return false, 
begin 

Place_In_L := L; 
while Place_In_L /= null loop 
if Equal (Place_In_L . Inf o, Element) then 
return true; 
end if; 

Place_In_L := Place_In_L . Next ; 

end loop; 
return false; 

end IsInList; 



function IsEmpty (Lr in List) return boolean is 
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-- I Is the list L empty. 



begin 

return (L = null) ; 
end IsEmpty; 



function LastValue (L: in List) return ItemType is 

LastElement : List; 

— I Return the value of the last element of the list. Get the pointer 

— I to the last element of L and then return its information. 

begin 

LastElement := Last (L) ; 
return LastElement . Inf o; 
end LastValue; 



function Length (L: in List) return integer is 

— I Recursively compute the length of L. The length of a list is 
--| 0 if it is null or 1 + the length of the tail. 

begin 

if L = null then 
return ( 0 ) ; 

» else 

return (1 + Length (Tail (L) ) ) ; 
end if; 
end Length; 



function MakeList ( 

E :in ItemType 

) return List is 

begin 

return new Cell ' (Info => E, Next => null) ; 

end; 



function MakeListIter (L: in List) return Listiter is 

— I Start an iteration operation on the list L. Do a type conversion 

— I from List to Listiter. 
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begin 

return Listiter (L) ; 
end MakeListIter; 



function More (L: in Listiter) return boolean is 

— I This is a test to see whether an iteration is complete. 

begin 

return L /- null; 

end; 



procedure Next (Place: in out Listiter; 

Info: out ItemType ) is 

PlaceInList: List; 

— I This procedure gets the information at the current place in the List 

— I and moves the Listiter to the next postion in the list. 

— t If we are at the end of a list then exception NoMore is raised. 

begin 

if Place = null then 
raise NoMore; 
else 

PlaceInList := List (Place) ; 

Info := PlaceInList . Inf o ; 

Place := Listiter (PlaceInList . Next ) ; 
end if; 
end Next; 



procedure ReplaceHead (L: in out List; 

Info: in ItemType ) is 

— I This procedure replaces the information at the head of a list 

— I with the given information. If the list is empty the exception 
--| EmptyList is raised. 

begin 

if L = null then 
raise EmptyList; 
else 

L.Info := Info; 
end if; 

end ReplaceHead; 
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procedure ReplaceTail (L: in out List; 

NewTail: in List ) is 

Temp_L: List; 

-- I This destroys the tail of a list and replaces the tail with 
— I NewTail. If L is empty EmptyList is raised. 

begin 

Destroy (L . Next ) ; 

L.Next := NewTail; 
exception 

when constraint_error => 
raise EmptyList; 
end ReplaceTail; 



function Tail (L: in List) return List is 

— I This returns the list which is the tail of L. If L is null 
— I EmptyList is raised. 

begin 

if L = null then 

raise EmptyList; 

el se 

return L.Next; 
end if; 

end Tail; 



function CellValue ( 

I : in List Iter 
) return ItemType is 
L :List; 
begin 

-- Convert I to a List type and then return the value it points to. 
L := List (I) ; 
return L.Info; 
end CellValue; 



function Equal (Listl : in List; 

List2: in List ) return boolean is 

PlaceInList 1 : List; 

Placel nList2 : List; 

Contentsl: ItemType; 
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Content s2 : 



ItemType ; 



This function tests to see if two lists are equal. Two lists 
are equal if for all the elements of Listl the corresponding 
element of List2 has the same value. Thus if the 1st elements 
are equal and the second elements are equal and so up to n. 

Thus a necessary condition for two lists to be equal is that 
they have the same number of elements. 



This function walks over the two list and checks that the 

corresponding elements are equal. As soon as we reach 

the end of a list (PlaceInList = null) we fall out of the loop. 

If both PlacelnListl and PlaceInList2 are null after exiting the loop 
then the lists are equal. If they both are not null the lists aren't 
equal. Note that equality on elements is based on a user supplied 
function Equal which is used to test for item equality. 



begin 

PlacelnListl := Listl; 

PlaceInList2 := List2; 

while (PlacelnListl /= null) and (PlaceInList2 /= null) loop 
if not Equal (PlacelnListl . Inf o, PlaceInList2 . Inf o) then 
return false; 
end if; 

PlacelnListl := PlaceInList 1 . Next ; 

PlaceInList2 := PlaceInList2 . Next ; 
end loop; 

return ( (PlacelnListl = null) and (PlaceInList2 = null) ) ; 
end Equal; 
end Lists; 
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APPENDIX Q. UTILITY PACKAGES 



— $Source: /tmp_mnt /n/gemini/work/bayram/AYACC/parser/RCS/lookahead_s , a, v $ 

— $Date: 1991/08/25 01:39:48 $ 

— $Revision: 1.1 $ 

— $Log: lookahead_s . a, V $ 

— Revision 1,1 1991/08/25 01:39:48 bayram 

— Initial revision 

with Io_Exceptions ; 
with Text_IO; 
use Text_IO; 

package Lookahead_Pkg is 
function Peek 

return CHARACTER; 
procedure Get__Char 

( Item : out CHARACTER ) / 
procedure Skip_Char; 

End_Error : exception 

renames Io_Exceptions . End_Error; 

— Attempt to read past end of file. 

end Lookahead_Pkg; 



— SSource: /tmp_mnt /n/gemini/work/bayram/AYACC/parser/RCS /I ookahead_b . a , v $ 

— $Date: 1991/08/25 01:42:22 $ 

— $Revision: 1.1 $ 

— $Log: lookahead_b . a, V $ 

— Revision 1.1 1991/08/25 01:42:22 bayram 

— Initial revision 

package body Lookahead_Pkg is 
Buffer 

: CHARACTER; 

Empty 

: BOOLEAN := TRUE; 

— (^empty => buffer is the next character in the stream) , 

function Peek 

return CHARACTER is 
begin — Peek 
if Empty then 
Get (Buffer) ; 

Empty := False; 
end if; 

return Buffer; 
end Peek; 
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procedure Get_Char 

( Item : out CHARACTER ) is 
begin — Get_Char 
if Empty then 

Get ( Item) ; 
else 

Item := Buffer; 

Empty := TRUE; 
end if; 
end Get__Char; 

procedure Skip_Char is 
begin — Skip_Char 
if Empty then 

Get (Buffer) ; 
else 

Empty := TRUE; 
end if; 

end Skip_Char; 
end Lookahead__Pkg; 



— Read and discard next character 

— Discard character in the buffer 



— $Source : /tmp_mnt /n /gemini/work/bayram/AYACC/parser/psdl__ada . lib/RCS/ 

delimiter . a, V $ 

— $Date: 1991/08/25 01:35:28 $ 

— $Revision: 1.1 $ 

— $Log: delimiter . a , V $ 

— Revision 1.1 1991/08/25 01:35:28 bayram 

— Initial revision 

package Delimiter__Pkg is 
type DELIMITER_ARRAY is 
array (CHARACTER) 
of BOOLEAN; 

function Initialize_Delimiter_Array 
return DELIMITER_ARRAY; 
end Delimiter^Pkg; 

package body Delimiter^Pkg is 

function Init ialize_Delimiter_Array 
return DELIMITER_ARRAY is 
begin — Initialize_Delimiter_Array 

return (' ' | Ascii. Ht 1 Ascii. Cr j Ascii. Lf => TRUE, others => False); 

end Initialize_Delimiter_Array ; 
end Delimiter__Pkg; 
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APPENDIX R. PACKAGE PSDL LEX 



— A lexical scanner generated by aflex 
with text_io; use text_io; 

with psdl_lex_df a; use psdl_lex_df a; 
with psdl_lex_io; use psdl_lex_io; 

— # line 1 "psdl_lex.l" 

— 3Source: /n/gemini/work/bayram/AYACC/parser/RCS/psdl_lex . 1, v $ 

— $Date: 1991/09/08 07:08:33 $ 

-- $Revision: 1.12 $ 



with psdl_tokens, a_strings, psdl_concrete_type_pkg; 
use psdl_tokens, a_strings, psdl_concrete_t ype_pkg; 
use text_io; 



package psdl_lex is 

1 ; 

0 ; 

type; 



lines : positive := 
num_errors : natural :■ 
List File: text io.file 



— in the case that one id comes right after another id 

— we save the previous one to get around the problem 

— that look ahead token is saved into yytext 

— This problem occurs in the optional_generic_param if 

— an optinal type declaration comes after that. 

— IDENTIFIER 

the_prev_id_token : psdl_id := psdl_id (a_strings . empty ) ; 

the_id_token : psdl_id := psdl_id (a_strings . empty ) ; 



— STRING_LITERAL 

the_st ring_t oken : expression := expression (a_strings . empty ) ; 



— INTEGER_LITERAL (psdl_id or expression) 
the_integer_token : a_string := a_strings . empty ; 

— REAL_LITERAL 

the_real_t oken : expression := expression (a_st rings . empty ) ; 

— TEXT_TOKEN 

the_text_t oken : text := empty_text; 



la st^yylength : integer; 



procedure linenum; 
procedure myecho; 



function yylex return token; 
end psdl_lex; 
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package body psdl_lex is 
procedure myecho is 
begin 

text_io . put (List_File, psdl_lex_df a . yytext ) / 
end myecho; 

procedure linenum is 
begin 

text_io . put (List_File , integer ' image (lines) & 
lines := lines + 1; 
end linenum; 

function YYLex return Token is 

subtype short is integer range -32768 .. 327 67 ; 
yy_act : integer; 

yy_c : short; 

— returned upon end-of-file 
YY_END_TOK : constant integer := 0; 

YY_END_OF_BUFFER : constant := 85; 
subtype yy_state_type is integer; 
yy_current_state : yy_state_type ; 

INITIAL : constant := 0; 

yy_accept ; constant array ( 0 . . 61 9) of short := 

( 0 , 



0, 


0, 


85, 


84, 


83, 


CM 

(X) 


84, 


59, 


60, 


61 


57, 


55, 


65, 


56, 


66, 


58, 


79, 


64, 


69, 


54 


68, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


62, 


63, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


84, 


67, 


84, 


0, 


78, 


0 


72, 


53, 


52, 


0, 


79, 


51, 


50, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


20, 


77, 


77, 


77 


77, 


77, 


77, 


33, 


77, 


77, 


48, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


0, 


81, 


80, 


73 




47, 


77, 


0, 


77, 


77, 


77, 


77, 


77, 


12 


77, 


77, 


72, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


32, 


70, 


74, 


77, 


77 


77, 


71, 


77, 


38, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


49, 


77, 


0, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


77, 


77, 


77, 


32, 


77, 


77, 


77 


77, 


38, 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


77 


77, 


77, 


77, 


0, 


0, 


0, 


77, 


77, 


77, 


8, 
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11 , 


11, 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


21 , 


11 , 


75, 


45, 


77, 


77, 


77, 


0, 


0, 


0, 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


11 , 


21 , 


11 , 


11 , 


11 , 


77, 


0, 


0, 


0, 


77, 


11 , 


11 , 


11 , 


11 , 


11 , 


76, 


77, 


77, 


18, 


19, 


11 , 


11 , 


23, 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


0, 


77, 


43, 


11 , 


11 , 


11 , 


11 , 


0, 


0, 


0, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


0, 


11 , 


77, 


77, 


77, 


2, 


3, 


0, 


0, 


11 , 


11 , 


11 , 


77, 


77, 


77, 


15, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


35, 


36, 


0, 


11 , 


11 , 


11 , 


0, 


41, 


0, 


9, 


77, 


46, 


16, 


0, 


0, 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


11 , 


77, 


77, 


77, 


77, 


77, 


0, 


11 , 


11 , 


11 , 


0, 


0, 


77, 


0, 


5, 


77, 


77, 


6, 


11 , 


11 , 


77, 


17, 


77, 


77, 


77, 


25, 


77, 


11 , 


30, 


32, 


77, 


0, 


77, 


38, 


77, 


0, 


0, 


11 , 


0, 


11 , 


77, 


77, 


77, 


77, 


77, 


77, 


77, 


11 , 


11 , 


11 , 


0, 


77, 


77, 


0, 


0, 


77, 


0, 


0, 


11 , 


11 , 


11 , 


77, 


77, 


77, 


24, 


29, 


77, 


34, 


0, 


28, 


11 , 


0, 


0, 


77, 


0, 


0, 


77, 


11 , 


11 , 


11 , 


11 , 


77, 


29, 


77, 


0, 


77, 


0, 


0, 


11 , 


0, 


0, 


77, 


77, 


14, 


26, 


77, 


22, 


11 , 


11 , 


0, 


11 , 


0, 


0, 


44, 


0, 


0, 


77, 


11 , 


14, 


11 , 


11 , 


77, 


0, 


77, 


0, 


0, 


0, 


0, 


11 , 


11 , 


13, 


77, 


77, 


77, 


0, 


77, 


0, 


42, 


0, 


0, 


11 , 


77, 


77, 


77, 


77, 


0, 


77, 


0, 


0, 


0, 


1 , 


10, 


77, 


77, 


77, 


37, 


77, 


40, 


0, 


0, 


11 , 


77, 


77, 


77, 


0, 


0, 


77, 


29, 


11 , 


0, 


0, 


77, 


77, 


0, 


0, 


77, 


39, 


0, 

) ; 


0, 


11 , 


0, 


31, 


21, 


0, 


4, 


0 




yy ec : constant 


array (CHARACTER' FIRST . . 


CHARACTER' LAST) 


of 


short 


( 0, 
1, 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


2, 


3, 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


1. 


1, 


1/ 


1/ 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


1, 


2, 


1, 


4, 


1, 


1, 


1, 


5, 


1, 


6, 


1 , 


8, 


9, 


10, 


11, 


12, 


13, 


14, 


14, 


14, 


14, 


14, 


14, 


14, 


14, 


14, 


14, 


15, 


1, 


16, 


11 , 


18, 


1, 


1, 


19, 


20, 


21, 


22, 


23, 


24, 


25, 


26, 


21 , 


28, 


29, 


30, 


31, 


32, 


33, 


34, 


35, 


36, 


31 , 


38, 


39, 


40, 


41, 


42, 


43, 


28, 


44, 


45, 


46, 


1, 


28, 


1, 


47, 


48, 


49, 


50, 



30 ' 



51, 


52, 


53, 


54, 


55, 


00 

CM 


56, 


57, 


00 

m 


59, 


60, 


61, 


62, 


63, 


64, 


65, 


66, 


67, 


68, 


69, 


70, 


28, 


71, 


72, 


73, 


74, 


1 









: constant 


array (0 




74) 


of 


short ; 


: = 








0, 




















1, 1 , 


1, 


1, 




1, 


1, 


1, 


1/ 


1, 


1, 


1, 1, 


1, 


2, 




1, 


1/ 


1, 


1, 


2, 


2, 


2, 2, 


2, 


2, 




2, 


2, 


2, 


2, 


2, 


2, 


2, 2, 


2, 


2, 




2, 


2, 


2, 


2, 


2, 


2, 


2, 2, 


2, 


1, 




1, 


1, 


2, 


2, 


2, 


2, 


2, 2, 


2, 


2, 




2, 


2, 


2, 


2, 


2, 


2, 


CM 

CM 


2, 


2, 




2, 


2, 


2, 


2, 


2, 


2, 


3, 1, 


1, 


1 
















: constant 


array (0 




622) 


of 


short 











( 0 , 



0, 


0, 


725, 


726, 


726, 


726, 


71, 


726, 


726, 


726 


716, 


726, 


726, 


705, 


726, 


705, 


64, 


726, 


704, 


726 


703, 


57, 


676, 


61, 


62, 


60, 


64, 


61, 


685, 


64 


0, 


694, 


71, 


683, 


67, 


692, 


691, 


77, 


78, 


690 


685, 


678, 


726, 


726, 


69, 


640, 


CM 


73, 


68, 


76 


62, 


649, 


74, 


657, 


87, 


647, 


CD 


655, 


654, 


84 


00 

(ji 


653, 


648, 


642, 


628, 


726, 


683, 


108, 


726, 


125 


726, 


726, 


726, 


685, 


138, 


726, 


726, 


0, 


661, 


678 


674, 


668, 


647, 


84, 


663, 


660, 


653, 


653, 


664, 


666 


133, 


657, 


654, 


653, 


665, 


644, 


0, 


648, 


109, 


638 


638, 


136, 


657, 


0, 


640, 


654, 


0, 


638, 


639, 


127 


653, 


650, 


127, 


641, 


132, 


637, 


634, 


631, 


632, 


603 


619, 


615, 


609, 


159, 


606, 


603, 


596, 


596, 


606, 


608 


123, 


600, 


597, 


596, 


607, 


587, 


591, 


114, 


581, 


581 


124, 


599, 


583, 


596, 


581, 


582, 


118, 


595, 


592, 


130 


584, 


123, 


580, 


577, 


574, 


575, 


564, 


726, 


622, 


0 


0, 


0, 


602, 


177, 


604, 


148, 


614, 


611, 


608, 


0 


607, 


608, 


0, 


591, 


600, 


603, 


591, 


588, 


593, 


584 


582, 


579, 


592, 


582, 


587, 


160, 


0, 


0, 


580, 


581 


587, 


0, 


168, 


580, 


591, 


156, 


511 , 


587, 


586, 


583 


584, 


583, 


567, 


578, 


0, 


543, 


195, 


545, 


136, 


554 


551, 


548, 


547, 


548, 


532, 


540, 


543, 


532, 


529, 


534 


525, 


523, 


520, 


532, 


523, 


528, 


140, 


521, 


522, 


527 


154, 


521, 


531, 


144, 


518, 


527, 


526, 


523, 


524, 


523 


508, 


518, 


540, 


540, 


546, 


535, 


540, 


528, 


529, 


0 


528, 


0, 


529, 


523, 


538, 


523, 


523, 


532, 


520, 


533 


528, 


516, 


520, 


521, 


518, 


523, 


518, 


510, 


528, 


507 


512, 


506, 


510, 


510, 


514, 


502, 


516, 


201, 


519, 


501 


511, 


0, 


0, 


512, 


507, 


475, 


475, 


480, 


470, 


474 


463, 


464, 


463, 


464, 


458, 


472, 


458, 


458, 


466, 


455 


467, 


462, 


451, 


455, 


456, 


453, 


457, 


453, 


445, 


462 


442, 


447, 


441, 


445, 


445, 


448, 


437, 


450, 


208, 


453 



308 



436, 


445, 


446, 


441, 


458, 


464, 


458, 


461, 


459, 


454, 


456, 


461, 


449, 


448, 


0, 


459, 


457, 


0, 


0, 


452, 


463, 


0, 


445, 


441, 


442, 


441, 


438, 


453, 


437, 


436, 


451, 


214, 


440, 


449, 


446, 


216, 


432, 


218, 


437, 


0, 


444, 


424, 


433, 


400, 


406, 


400, 


403, 


401, 


396, 


398, 


402, 


391, 


390, 


400, 


398, 


394, 


404, 


387, 


383, 


384, 


383, 


380, 


394, 


379, 


378, 


392, 


220, 


382, 


390, 


387, 


222, 


374, 


224, 


379, 


385, 


366, 


375, 


0, 


726, 


394, 


409, 


406, 


411, 


399, 


394, 


400, 


399, 


0, 


404, 


401, 


393, 


400, 


390, 


397, 


396, 


387, 


380, 


383, 


0, 


0, 


226, 


378, 


377, 


386, 


228, 


0, 


385, 


0, 


375, 


0, 


0, 


344, 


358, 


355, 


360, 


349, 


344, 


349, 


348, 


353, 


350, 


343, 


349, 


340, 


346, 


345, 


337, 


330, 


333, 


230, 


328, 


327, 


335, 


232, 


334, 


325, 


360, 


726, 


234, 


359, 


0, 


347, 


351, 


350, 


0, 


350, 


351, 


343, 


0, 


358, 


357, 


0, 


0, 


341, 


349, 


352, 


0, 


353, 


346, 


341, 


348, 


315, 


236, 


314, 


303, 


307, 


306, 


306, 


307, 


299, 


313, 


312, 


297, 


304, 


307, 


308, 


301, 


297, 


303, 


317, 


238, 


320, 


324, 


318, 


317, 


310, 


304, 


0, 


313, 


312, 


0, 


313, 


0, 


324, 


311, 


318, 


318, 


276, 


241, 


279, 


282, 


277, 


276, 


269, 


263, 


272, 


271, 


272, 


282, 


270, 


276, 


276, 


302, 


301, 


285, 


289, 


284, 


0, 


301, 


0, 


287, 


286, 


294, 


278, 


292, 


278, 


0, 


262, 


261, 


246, 


250, 


245, 


261, 


242, 


241, 


248, 


233, 


245, 


231, 


262, 


256, 


254, 


258, 


0, 


250, 


265, 


264, 


249, 


257, 


247, 


726, 


224, 


218, 


216, 


220, 


213, 


227, 


226, 


212, 


219, 


210, 


248, 


243, 


0, 


0, 


242, 


231, 


230, 


726, 


232, 


726, 


212, 


207, 


206, 


196, 


193, 


195, 


222, 


220, 


219, 


0, 


219, 


191, 


189, 


188, 


188, 


208, 


223, 


180, 


0, 


143, 


138, 


106, 


93, 


726, 


0, 


46, 


726, 


726, 


302, 


91, 

t 
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: constant 

n 


array ( 0 . . 622 ) of 


short 


: = 








t 

619, 


1, 


619, 


619, 


619, 


619, 


620, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


619, 


619, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


622, 


619, 


619, 


620, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


621, 


622, 


619, 


619, 


621, 
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621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


62 . 1 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


621 , 


619 , 


619 , 


621 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


621 , 


619 , 


621 , 


619 , 


619 , 


619 , 


621 , 


621 , 


621 , 


621 , 


619 , 


619 , 


621 , 


621 , 


621 , 


619 , 


619 , 


621 , 


621 , 


619 , 


619 , 


621 , 


621 , 


619 , 

619 , 


619 , 

619 


621 , 


619 , 


619 , 


621 , 


619 , 


619 , 


0 , 


619 , 



) ; 



yy__nxt ; constant array ( 0 . . 8 00 ) of short : = 
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( 0 , 



4 , 


5 , 


6 , 


7 , 


8 , 


9 , 


10 , 


11 , 


12 , 


13 , 


14 , 


15 , 


16 , 


17 , 


18 , 


19 , 


20 , 


21 , 


22 , 


23 , 


24 , 


25 , 


26 , 


27 , 


28 , 


29 , 


30 , 


31 , 


32 , 


31 , 


33 , 


34 , 


35 , 


36 , 


31 , 


37 , 


38 , 


39 , 


31 , 


40 , 


41 , 


42 , 


31 , 


43 , 


4 , 


44 , 


45 , 


46 , 


47 , 


48 , 


49 , 


50 , 


51 , 


52 , 


53 , 


54 , 


31 , 


55 , 


56 , 


57 , 


58 , 


31 , 


59 , 


60 , 


61 , 


31 , 


62 , 


63 , 


64 , 


31 , 


65 , 


66 , 


4 , 


67 , 


69 , 


74 , 


79 , 


75 , 


80 , 


85 , 


87 , 


89 , 


92 , 


94 , 


88 , 


164 , 


164 , 


97 , 


81 , 


101 , 


93 , 


90 , 


78 , 


86 , 


98 , 


99 , 


95 , 


102 , 


82 , 


111 , 


106 , 


91 , 


107 , 


103 , 


114 , 


108 , 


83 , 


104 , 


125 , 


618 , 


112 , 


69 , 


134 , 


115 , 


113 , 


70 , 


120 , 


129 , 


121 , 


127 , 


116 , 


126 , 


132 , 


128 , 


135 , 


97 , 


130 , 


122 , 


68 , 


618 , 


133 , 


137 , 


138 , 


140 , 


148 , 


180 , 


131 , 


123 , 


144 , 


151 , 


107 , 


141 , 


181 , 


145 , 


149 , 


196 , 


142 , 


152 , 


150 , 


74 , 


104 , 


75 , 


70 , 


171 , 


153 , 


172 , 


184 , 


192 , 


200 , 


197 , 


207 , 


207 , 


198 , 


193 , 


616 , 


185 , 


173 , 


186 , 


221 , 


68 , 


201 , 


213 , 


225 , 


214 , 


222 , 


192 , 


234 , 


238 , 


164 , 


164 , 


226 , 


231 , 


227 , 


173 , 


248 , 


249 , 


267 , 


615 , 


239 , 


235 , 


272 , 


276 , 


236 , 


277 , 


308 , 


244 , 


207 , 


207 , 


268 , 


291 , 


292 , 


273 , 


358 , 


358 , 


313 , 


309 , 


317 , 


617 , 


318 , 


393 , 


393 , 


616 , 


245 , 


246 , 


314 , 


421 , 


421 , 


425 , 


425 , 


358 , 


358 , 


450 , 


450 , 


454 , 


454 , 


393 , 


393 , 


421 , 


421 , 


425 , 


425 , 


450 , 


450 , 


454 , 


454 , 


501 , 


501 , 


519 , 


519 , 


501 , 


501 , 


287 , 


519 , 


519 , 


615 , 


614 , 


610 , 


613 , 


612 , 


611 , 


610 , 


609 , 


608 , 


607 , 


606 , 


427 , 


104 , 


288 , 


289 , 


601 , 


605 , 


604 , 


603 , 


475 , 


602 , 


479 , 


104 , 


601 , 


600 , 


599 , 


598 , 


534 , 


591 , 


597 , 


589 , 


596 , 


595 , 


594 , 


585 , 


584 , 


593 , 


592 , 


591 , 


590 , 


589 , 


588 , 


587 , 


586 , 


455 , 


585 , 


584 , 


583 , 


582 , 


571 , 


494 , 


581 , 


497 , 


580 , 


579 , 


578 , 


577 , 


549 , 


68 , 


68 , 


68 , 


157 , 


157 , 


576 , 


564 , 


575 , 


574 , 


573 , 


572 , 


571 , 


570 , 


569 , 


568 , 


567 , 


566 , 


565 , 


564 , 


563 , 


562 , 


561 , 


560 , 


547 , 


559 , 


558 , 


557 , 


556 , 


555 , 


554 , 


540 , 


553 , 


538 , 


552 , 


551 , 


550 , 


548 , 


547 , 


546 , 


545 , 


544 , 


543 , 


542 , 


541 , 


540 , 


539 , 


538 , 


537 , 


536 , 


535 , 


533 , 


532 , 


531 , 


530 , 


529 , 


513 , 


528 , 


511 , 


527 , 


526 , 


508 , 


525 , 


524 , 


523 , 


522 , 


521 , 


520 , 


518 , 


517 , 


516 , 


515 , 


514 , 


513 , 


512 , 


511 , 


510 , 


509 , 


508 , 


507 , 


506 , 


505 , 


504 , 


503 , 


502 , 


500 , 


499 , 


498 , 


496 , 


477 , 


495 , 


493 , 


473 , 


472 , 


492 , 


491 , 


469 , 


490 , 


489 , 


488 , 


465 , 


487 , 


486 , 


485 , 


461 , 


484 , 


483 , 


458 , 


482 , 


481 , 


480 , 


478 , 


477 , 


476 , 


474 , 


473 , 


472 , 


471 , 


470 , 


469 , 


468 , 


467 , 


466 , 


465 , 


464 , 


463 , 


462 , 


461 , 


460 , 


459 , 


458 , 


457 , 


431 , 


430 , 


456 , 


428 , 


426 , 


453 , 


452 , 


451 , 


420 , 


419 , 


449 , 


448 , 


447 , 


446 , 


445 , 


444 , 


443 , 


442 , 


441 , 


440 , 


408 , 


439 , 


438 , 


437 , 


436 , 


435 , 


434 , 


433 , 


432 , 


399 , 


398 , 


431 , 


430 , 


429 , 


428 , 


426 , 


424 , 


423 , 


422 , 


420 , 


419 , 


418 , 


417 , 


416 , 


415 , 


414 , 


413 , 


412 , 


411 , 


410 , 


409 , 


408 , 


407 , 


406 , 


405 , 


404 , 


403 , 


402 , 


401 , 


400 , 


399 , 


398 , 


397 , 


396 , 


395 , 


360 , 


394 , 
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392, 


391, 


390, 


389, 


388, 


387, 


386, 


385, 


384, 


383 


382, 


381, 


380, 


379, 


378, 


342, 


311 , 


376, 


339, 


338 


375, 


374, 


335, 


373, 


372, 


371, 


370, 


369, 


368, 


367 


366, 


365, 


364, 


363, 


362, 


361, 


360, 


359, 


357, 


356 


355, 


354, 


353, 


352, 


351, 


350, 


349, 


348, 


347, 


346 


345, 


344, 


343, 


342, 


341, 


340, 


339, 


338, 


337, 


336 


335, 


334, 


333, 


332, 


331, 


330, 


329, 


328, 


327, 


326 


325, 


324, 


323, 


283, 


282, 


322, 


321, 


320, 


319, 


316 


315, 


312, 


311, 


310, 


307, 


306, 


305, 


304, 


303, 


302 


301, 


300, 


299, 


298, 


297, 


296, 


295, 


294, 


252, 


293 


250, 


290, 


286, 


285, 


284, 


283, 


282, 


281, 


280, 


279 


278, 


275, 


274, 


271, 


270, 


269, 


266, 


265, 


264, 


263 


262, 


261, 


260, 


259, 


258, 


257, 


256, 


255, 


254, 


253 


252, 


251, 


250, 


247, 


243, 


159, 


158, 


205, 


242, 


241 


240, 


237, 


233, 


232, 


230, 


229, 


228, 


188, 


187, 


224 


223, 


220, 


219, 


218, 


217, 


216, 


215, 


170, 


212, 


211 


210, 


209, 


208, 


206, 


162, 


161, 


160, 


205, 


204, 


203 


202, 


199, 


195, 


194, 


191, 


190, 


189, 


188, 


187, 


183 


182, 


179, 


178, 


177, 


176, 


175, 


174, 


170, 


169, 


168 


167, 


166, 


165, 


161, 


163, 


162, 


161, 


160, 


159, 


73 


158, 


156, 


155, 


154, 


147, 


146, 


143, 


139, 


136, 


124 


119, 


118, 


117, 


110, 


109, 


105, 


100, 


96, 


84, 


77 


76, 


73, 


72, 


71, 


619, 


3, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619 


/ 

; constant 
n 


array (0 . . 800) of 


short 


: = 








1, 


1, 


1, 


1/ 


1/ 


1/ 


1, 


1/ 


1/ 


1. 


1, 


1, 


1/ 


1, 


1, 


1, 


1, 


1/ 


1, 


1. 


1, 


1, 


1, 


1, 


1. 


1, 


1, 


1, 


1/ 


1. 


1/ 


1, 


1. 


1, 


1, 


1/ 


1, 


1, 


1, 


1. 


1, 


1/ 


1/ 


1. 


1, 


1/ 


1, 


1, 


1, 


1. 


1/ 


1/ 


1/ 


1/ 


1, 


1, 


1, 


1, 


1, 


1. 


1/ 


1/ 


1/ 


1, 


1/ 


1, 


1, 


1, 


1, 


1. 


1/ 


1/ 


1, 


1, 


7, 


17, 


22, 


17, 


22, 


24, 


25, 


26, 


27, 


28, 


25, 


84, 


84, 


30, 


22, 


33, 


27, 


26, 


621, 


24, 


30, 


30, 


28, 


33, 


22, 


38, 


35, 


26, 


35, 


33, 


39, 


35, 


22, 


33, 


47, 


617, 


38, 


68, 


51, 


39, 


38, 


If 


45, 


49, 


45, 


48, 


39, 


47, 


50, 


48, 


51, 


53, 


49, 


45, 


70, 


614, 


50, 


53, 


53, 


55, 


60, 


99, 


49, 


45, 


57, 


61, 


57, 


55, 


99, 


57, 


60, 


113, 


55, 


61, 


60, 


75, 


55, 


75, 


68, 


91, 


61, 


91, 


102, 


110, 


115, 


113, 
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124 , 


124 , 


113 , 


110 , 


613 , 


102 , 


91 , 


102 , 


138 , 


70 , 


115 , 


131 , 


141 , 


131 , 


138 , 


147 , 


150 , 


152 , 


164 , 


164 , 


141 , 


147 , 


141 , 


131 , 


166 , 


166 , 


186 , 


612 , 


152 , 


150 , 


193 , 


196 , 


150 , 


196 , 


227 , 


164 , 


207 , 


207 , 


186 , 


209 , 


209 , 


193 , 


278 , 


278 , 


231 , 


221 , 


234 , 


611 , 


234 , 


319 , 


319 , 


609 , 


164 , 


164 , 


231 , 


352 , 


352 , 


356 , 


356 , 


358 , 


358 , 


387 , 


387 , 


391 , 


391 , 


393 , 


393 , 


421 , 


421 , 


425 , 


425 , 


450 , 


450 , 


454 , 


454 , 


459 , 


459 , 


483 , 


483 , 


501 , 


501 , 


207 , 


519 , 


519 , 


608 , 


607 , 


606 , 


605 , 


604 , 


603 , 


602 , 


600 , 


599 , 


598 , 


597 , 


358 , 


596 , 


207 , 


207 , 


595 , 


594 , 


593 , 


592 , 


421 , 


590 , 


425 , 


588 , 


587 , 


586 , 


583 , 


582 , 


501 , 


581 , 


580 , 


579 , 


578 , 


577 , 


576 , 


575 , 


574 , 


573 , 


572 , 


570 , 


569 , 


568 , 


561 , 


566 , 


565 , 


393 , 


563 , 


562 , 


561 , 


560 , 


559 , 


450 , 


558 , 


454 , 


557 , 


556 , 


555 , 


554 , 


519 , 


620 , 


620 , 


620 , 


622 , 


622 , 


553 , 


552 , 


551 , 


550 , 


549 , 


548 , 


546 , 


545 , 


544 , 


543 , 


542 , 


541 , 


539 , 


537 , 


536 , 


535 , 


534 , 


533 , 


532 , 


531 , 


530 , 


529 , 


528 , 


527 , 


526 , 


525 , 


524 , 


523 , 


522 , 


521 , 


520 , 


518 , 


517 , 


516 , 


515 , 


514 , 


512 , 


510 , 


509 , 


507 , 


506 , 


505 , 


504 , 


503 , 


502 , 


500 , 


499 , 


498 , 


497 , 


496 , 


495 , 


494 , 


493 , 


492 , 


491 , 
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44 4 , 


443 , 


442 , 
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361 , 
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334 , 
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330 , 
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268 , 
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264 , 


263 , 


262 , 


261 , 


260 , 
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257 , 


256 , 


255 , 


254 , 


253 , 


251 , 


249 , 


248 , 


247 , 


246 , 


245 , 


244 , 


243 , 
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241 , 
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212 , 
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174 , 
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139 , 


137 , 


136 , 


135 , 


134 , 


133 , 


132 , 


130 , 


129 , 


128 , 
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127, 


126, 


125, 


123, 


122, 


121, 


120, 


119, 


118, 


117 


116, 


114, 


112, 


111, 


109, 


108, 


106, 


105, 


103, 


101 


100, 


98, 


96, 


95, 


94, 


93, 


92, 


90, 


89, 


88 


87, 


86, 


85, 


83, 


82, 


81, 


80, 


79, 


74, 


67 


65, 


64, 


63, 


62, 


59, 


58, 


56, 


54, 


52, 


46 


42, 


41, 


40, 


37, 


36, 


34, 


32, 


29, 


23, 


21 


19, 


16, 


14, 


11, 


3, 


619, 
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619, 
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619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 


619, 
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) ; 

— copy whatever the last rule matched to the standard output 

procedure ECHO is 
begin 

text_io.put( yytext ); 
end ECHO; 

— enter a start condition. 

— Using procedure requires a () after the ENTER, but makes everything 

— much neater. 

procedure ENTER ( state : integer ) is 
begin 

yy_start := 1 + 2 * state; 
end ENTER; 

-- action number for EOF rule of a given start state 
function YY_STATE_EOF ( state : integer) return integer is 
begin 

return YY_END_OF_BUFFER + state + 1; 
end YY_STATE_EOF; 

— return all but the first 'n' matched characters back to the input stream 
procedure yyless (n : integer) is 

begin 

yy_ch_buf (yy_cp) := yy_hold_char; — undo effects of setting up yytext 
yy_cp := yy_bp + n; 
yy_c_buf_p := yy_cp; 

YY_DO_BEFORE_ACT ION; -- set up yytext again 
end yyless; 

— redefine this if you have something you want each time, 
procedure YY_USER_ACTION is 

begin 

null ; 

end; 
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function y y_get_previous_state return yy_state_type is 
yy_current_state : y y_state_type ; 
yy_c : short/ 
begin 

yy_current_state ;= yy_start; 

for yy_cp in yytext_ptr . . yy_c_buf_p - 1 loop 
yy_c := yy_ec (yy_ch_buf (yy_cp) ) ; 
if ( yy^accept (yy_current_state) /= 0 ) then 

yy_last_accept ing_state ;= yy_current_st ate ; 
yy_last_accepting_cpos := yy_cp; 
end if; 

while ( yy_chk (yy_base (yy_current_state ) + yy_c) /= yy_current_state ) 

yy_current_state := yy_def (yy_current_state) / 
if ( yy_current_state >= 620 ) then 
yy_c := yy_meta (yy_c) ; 
end if; 
end loop; 

yy_cur rent_state yy_nxt (yy_base (yy_current_state) + yy_c) ; 

end loop; 

return yy_current_state ; 
end yy_get_previous_state; 

procedure yyrestart( input_file : file_type ) is 

begin 

set_input (input_file) ; 
yy_init := true; 
end yyrestart; 

begin — of YYLex 
<<new_f ile>> 

— this is where we enter upon encountering an end-of-file and 

— yywrapO indicating that we should continue processing 

if ( yy_init ) then 

if ( yy_start = 0 ) then 

yy_start := 1; ~~ first start state 

end if; 

— we put in the '\n' and start reading from [1] so that an 

— initial match-at-newline will be true. 

yy_ch_buf(0) := ASCII. LF; 
yy_n_chars := 1; 

— we always need two end-of -buf f er characters. The first causes 

— a transition to the end-of-buf f er state. The second causes 

— a jam in that state. 

yy_ch_buf (yy_n_chars) := YY_END_OF_BUFFER_CHAR; 
yy_ch_buf (yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR; 



loop 



yy_eof_has_been_seen := false; 

yytext_ptr := 1; 
yy_c_buf_p ;= yytext_ptr; 
yy_hold_char ;= yy_ch_buf (yy_c_buf_p) ; 
yy_init := false; 
end if; — yy_init 

loop — loops until end-of-file is reached 

yy_cp := yy_c_buf_p; 

— support of yytext 
yy_ch_buf (yy_cp) := yy_hold_char ; 

— yy_bp points to the position in yy_ch_buf of the start of the 

— current run . 
yy_bp := yy_cp; 
yy_current_state := yy_start; 
loop 

yy_c := yy_ec (yy_ch_buf (yy_cp) ) ; 

if ( yy_accept (yy_current_st ate ) /= 0 ) then 

yy_last_accept ing_state := yy_current_state; 
yy_last_accepting_cpos := yy_cp; 
end if; 

while ( yy_chk (yy_base (yy_current_state ) + yy_c) /= yy_current_state ) 
yy_current_state := yy_def (yy_current_state) ; 
if ( yy_current_state >= 620 ) then 
yy_c := yy_met a (yy_c) ; 
end if; 
end loop; 

yy_current_state := yy_nxt (yy_base (yy_current_state) + yy_c) ; 
yy_cp := yy_cp + 1; 
if ( yy_current_state = 619 ) then 
exit ; 
end if; 

end loop; 

yy_cp := yy_last_accepting_cpos; 
yy_current_state := yy_last_accepting_state; 

<<next_a ct ion>> 

yy_act := yy_accept (yy_current_state ) ; 

YY_DO_BEFORE_ACTION; 

Y Y_US E R_AC T I ON ; 

if aflex_debug then — output acceptance info, for (-d) debug mode 
text_io.put( Standard_Error, " — accepting rule ); 

text_io.put( Standard_Error, INTEGER' IMAGE (yy_act) ); 
text_io . put_line ( St andard_Error , «("«" & yytext & 

end if; 

<<do_act ion>> — this label is used only to access EOF actions 
case yy_act is 
when 0 => — must backtrack 

— undo the effects of YY DO BEFORE ACTION 



loop 
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yy_ch_buf (yy_cp) := yy_hold_char ; 
yy cp := yy_last_accept ing_cpos; 
yy_current_state := yy_last_accept ing_state 
goto next_action; 



when 1 => 

— # line 66 "psdl_lex.l" 

MYECHO; return (ADA_TOKEN) ; 

when 2 => 

— I line 67 "psdl_lex . 1'' 

MYECHO; return (AXIOMS_TOKEN) ; 

when 3 => 

— # line 68 "psdl_lex.l" 

MYECHO; return (BY_ALL_TOKEN) ; 

when 4 => 

— # line 69 "psdl^lex.l" 

MYECHO; return (BY_REQ_TOKEN) ; 

when 5 => 

— # line 71 "psdl_lex.l" 

MYECHO; return (BY_SOME_TOKEN) ; 

when 6 => 

— # line 72 "psdl_lex.l" 

MYECHO; return (CONTROL_TOKEN) ; 

when 7 => 

— # line 73 "psdl_lex,l" 

MYECHO; return (CONSTRAINTS_TOKEN) ; 

when 8 => 

— # line 7 4 "psdl_lex.l" 

MYECHO; return (DATA_TOKEN) ; 

when 9 => 

— # line 75 "psdl_lex.l" 

MYECHO; return (STREAM_TOKEN) ; 

when 10 => 

— # line 76 "psdl_lex.l" 

MYECHO; return (DESCRIPTION_TOKEN) ; 

when 11 => 

— # line 77 "psdl_lex.l" 

MYECHO; return (EDGE_TOKEN) ; 

when 12 => 

— I line 78 "psdl_lex.l" 

MYECHO; return (END_TOKEN) ; 
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when 13 => 

— # line 79 "psdl_lex.l" 

MYECHO; return (EXCEPTIONS_TOKEN) ; 

when 14 => 

— # line 80 "psdl_lex.l" 

MYECHO; return {EXCEPTION_TOKEN) ; 

when 15 => 

— # line 81 "psdl_lex.l" 

MYECHO; return {FINISH_TOKEN) ; 

when 16 => 

— # line 82 "psdl_lex.l" 

MYECHO; return (WITHIN_TOKEN) ; 

when 17 => 

— # line 83 "psdl_lex.l" 

MYECHO; return (GENERIC__TOKEN) / 

when 18 => 

— # line 84 "psdl_lex.l" 

MYECHO; return (GRAPH_TOKEN) ; 

when 19 => 

— # line 85 "psdl_lex.l" 

MYECHO; return (HOURS_TOKEN) ; 

when 20 => 

-“# line 86 "psdl_lex.l" 

MYECHO; return (IF_TOKEN) ; 

when 21 => 

— # line 87 "psdl_lex.l" 

MYECHO; return ( IMPLEMENTATION_TOKEN) ; 

when 22 => 

— # line 88 "psdl_lex.l" 

MYECHO; return (INITIALLY_TOKEN) / 

when 23 => 

— I line 89 "psdl_lex.l" 

MYECHO; return (INPUT_TOKEN) ; 

when 24 => 

— # line 90 "psdl_lex.l" 

MYECHO; return (KEYWORDS_TOKEN) ; 

when 25 => 

— # line 91 "psdl_lex.l" 

MYECHO; return (MAXIMUM_TOKEN) ; 

when 26 => 

— # line 92 ”psdl_lex.l" 

MYECHO; return (EXECUTION_TOKEN) ; 
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when 27 => 

— # line 93 "psdl_lex . 1 '' 

MYECHO; return (TIME_TOKEN) / 

when 28 => 

— # line 94 "psdl_lex . 1 '' 

MYECHO; return (RESPONSE_TOKEN) ; 

when 29 => 

— # line 95 "psdl_lex.l" 

MYECHO; return (MICROSEC_TOKEN) ; 

when 30 => 

— # line 96 "psdl_lex.l" 

MYECHO; return (MINIMUM_TOKEN) ; 

when 31 => 

— # line 97 "psdl_lex.l" 

MYECHO; return (CALL_PERIOD_TOKEN) ; 

when 32 => 

— # line 98 "psdl_lex . 1'' 

MYECHO; return (MIN_TOKEN) ; 

when 33 => 

— # line 99 "psdl_lex.l" 

MYECHO; return (MS_TOKEN) ; 

when 34 => 

— # line 100 "psdl_lex.l" 

MYECHO; return (OPERATOR_TOKEN) ; 

when 35 => 

— # line 101 "psdl_lex.l" 

MYECHO; return (OUTPUT_TOKEN) ; 

when 36 => 

— # line 102 "psdl_lex . 1 '' 

MYECHO; return (PERIOD_TOKEN) ; 

when 37 => 

— # line 103 "psdl_lex.l" 

MYECHO; return (RESET_TOKEN) ; 

when 38 => 

— # line 104 ”psdl_lex.l" 

MYECHO; return (SEC_TOKEN) ; 

when 39 => 

— # line 105 ”psdl_lex.l" 

MYECHO; return ( SPECIFICATION_TOKEN) ; 

when 40 => 

— # line 106 "psdl_lex.l" 
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MYECHO; return (START_TOKEN) ; 

when 41 => 

— I line 107 "psdl_lex . 1 " 

MYECHO; return (STATES_TOKEN) ; 

when 42 => 

— # line 108 "psdl_lex.l" 

MYECHO; return (STOP_TOKEN) ; 

when 43 => 

— # line 109 "psdl_lex.l" 

MYECHO; return (TIMER_TOKEN) ; 

when 44 => 

— # line 110 "psdl_lex.l" 

MYECHO; return (TRIGGERED_TOKEN) ; 

when 45 => 

— # line 111 "psdl_lex.l" 

MYECHO; return (TYPE_TOKEN) ; 

when 46 => 

— # line 112 "psdl_lex.l" 

MYECHO; return (VERTEX_TOKEN) ; 

when 47 => 

— # line 114 "psdl_lex.l" 

MYECHO; return (AND_TOKEN) ; 

when 48 => 

— # line 115 "psdl_lex.l" 

MYECHO; return (OR_TOKEN) ; 

when 49 => 

— # line 116 "psdl_lex.l" 

MYECHO; return (XOR_TOKEN) ; 

when 50 => 

— # line 117 "psdl_lex.l" 

MYECHO; return (GREATER_THAN_OR_EQUAL) 

when 51 => 

— # line 118 "psdl_lex.l" 

MYECHO; return (LESS_THAN_OR_EQUAL) ; 

when 52 => 

— I line 119 "psdl_lex.l" 

MYECHO; return (INEQUALITY); 

when 53 => 

— # line 120 "psdl_lex.l" 

MYECHO; return (ARROW) ; 



when 54 => 



— I line 121 "psdl_lex . 
MYECHO; return ('='); 

when 55 => 

— # line 122 "psdl_lex . 
MYECHO; return ('+')/ 

when 56 => 

— # line 123 "psdl_lex . 
MYECHO; return 

when 57 => 

— # line 124 "psdl_lex . 
MYECHO; return ('*'); 

when 58 => 

— # line 125 "psdl_lex . 
MYECHO; return ('/'); 

when 59 => 

— # line 126 "psdl_lex . 
MYECHO; return ('&'); 

when 60 => 

— # line 127 "psdl_lex . 
MYECHO; return ('('); 

when 61 => 

— # line 128 "psdl_lex . 
MYECHO; return (')'); 

when 62 => 

— I line 129 "psdl_lex . 
MYECHO; return ('['); 

when 63 => 

— # line 130 "psdl_lex . 
MYECHO; return (']'); 

when 64 => 

— # line 131 "psdl_lex . 
MYECHO; return (':'); 

when 65 => 

line 132 "psdl_lex . 
MYECHO; return 

when 66 => 

— # line 133 "psdl_lex . 
MYECHO; return 

when 67 => 

— # line 134 "psdl_lex . 
MYECHO; return ( ' T ) ; 
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when 68 => 

— # line 135 "psdl_lex . 1 " 

MYECHO; return ('>'); 

when 69 => 

— t line 136 "psdl_lex . 1 " 

MYECHO; return ('<'); 

when 70 => 

— # line 137 "psdl_lex.l" 

MYECHO; return (MOD_TOKEN) ; 

when 7 1 => 

— # line 138 "psdl_lex.l" 

MYECHO; return (REM_T0KEN) ; 

when 72 => 

— # line 139 "psdl_lex.l" 

MYECHO; return (EXP_TOKEN) ; 

when 73 => 

line 140 "psdl_lex.l" 

MYECHO; return (ABS_TOKEN) ; 

when 74 => 

— # line 141 ”psdl_lex . 1" 

MYECHO; return (NOT_TOKEN) ; 

when 75 => 

— # line 142 "psdl_lex.l" 

MYECHO; return (TRUE) ; 

when 76 => 

— # line 143 "psdl_lex.l" 

MYECHO; return (FALSE); 

when 77 => 

— # line 145 "psdl_lex.l" 

MYECHO; 

the_prev_id_token := the__id_token; 
the_id_token := to_a (psdl_lex_df a . yytext ) 

return (IDENTIFIER) ; 



when 78 => 

— # line 152 "psdl_lex.l" 

MYECHO; 

the_st ring_t oken := to_a (psdl_lex_df a . yytext ) 
return (STRING_LITERAL) ; 

when 1 9 -> 

— # line 158 "psdl_lex.l" 
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MYECHO; 

the_integer_token := to_a (psdl__lex_df a . yytext ; ; 
return ( INTEGER_LITERAL) ; 



when 80 => 

— # line 164 "psdl_lex.l" 

MYECHO; 

the_real_token := to_a (psdl_lex_df a . yy text ) ; 
return { REAL_LITERAL) ; 



when 81 => 

— # line 170 "psdl_lex.l" 

MYECHO; 

the_text_token := to_a (psdl_lex_df a . yytext ) ; 

return (TEXT_TOKEN) ; 



when 82 = > 

— # line 176 "psdl_lex.l" 

MYECHO; linenum; 

when 83 => 

— # line 177 "psdl_lex.l" 

MYECHO; null; -- ignore spaces and tabs 

when 84 = > 

— # line 180 "psdl_lex.l" 
raise AF LEX_SC ANNE R_ JAMMED ; 
when YY_END_OF_BUFFER + INITIAL + 1 => 
return End_Of_Input ; 

when YY_END_OF_BUFFER => 

— undo the effects of YY_DO_BEFORE_ACTlON 
yy_ch_buf (yy_cp) := yy_hold_char ; 

yytext_ptr := yy_bp; 

case yy_get_next_buf f er is 

when EOB_ACT_END_OF_FILE => 
begin 

if ( yywrap ) then 

— note: because we've taken care in 

— yy_get_next_buf f er ( ) to have set up yytext, 

— we can now set up yy_c_buf_p so that if some 
-- total hoser {like aflex itself) wants 

— to call the scanner after we return the 
-- End_Of_Input , it'll still work - another 
— End_Of_Input will get returned. 

yy_c_buf_p := yytext_ptr; 
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yy_act := YY_STATE_EOF ( (yy_start - 1) / 2) 

goto do_action; 

else 

— start processing a new file 
yy_init := true; 
goto new_file; 
end if; 
end; 

when EOB_ACT_RESTART_SCAN => 
yy_c_buf_p := yytext_ptr; 
yy_hold_char ;= yy_ch_buf ( yy_c_buf _p ) ; 
when E0B_ACT_LASTJ1ATCH => 

yy_c_buf_p := yy_n_chars; 

yy_current_state := yy_get_previous_state; 

yy_cp := yy_c_buf_p; 
yy_bp := yytext_ptr; 
goto next_action; 
when others => null; 

end case; — case yy_get_next_buf f er ( ) 
when others => 

text_io.put( "action # " ) ; 
text_io.put( INTEGER' IMAGE (yy_act) ); 
text_io . new_line ; 
raise AFLEX_INTERNAL_ERROR; 
end case; — case (yy_act) 
end loop; — end of loop waiting for end of file 
end YYLex; 

— I line 180 "psdl_lex.l" 
end psdl_lex; 
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APPENDIX S. PACKAGE PSDL LEX lO 



with psdl_lex_df a; use psdl_lex_df a; 
with text_io; use text_io; 

package psdl_lex_io is 
NULL_IN_INPUT : exception; 

AFLEX_INTERNAL_ERROR : exception; 

UNEXPECTED_LAST_MATCH : exception; 

PUSHBACK_OVERFLOW : exception; 

AFLEX_SCANNER_JAMMED : exception; 

type eob_act ion_type is ( EOB_ACT_RESTART_SCAN, 

EOB_AC T_EN D_OF_F I LE , 

EOB_ACT_LAST_MATCH ) ; 

YY_END_OF_BUFFER_CHAR : constant character := ASCII. NUL; 

yy_n_chars : integer; — number of characters read into yy_ch_buf 

— true when we've seen an EOF for the current input file 
yy_eof_has_been_seen : boolean; 

procedure YY_INPUT (buf : out unbounded_character_array ; 

result: out integer; max_size : in integer); 

function yy_get_next_buf f er return eob_act ion_type ; 

procedure yyunput ( c : character; yy_bp : in out integer ); 

procedure unput (c : character); 

function input return character; 

procedure output (c : character) ; 

function yywrap return boolean; 

procedure Open_Input (fname : in String) ; 

procedure Close_Input; 

procedure Create_Output ( fname : in String := "") ; 

procedure Close_Output ; 
end psdl_lex_io; 



package body psdl_lex_io is 

— gets input and stuffs it into 'buf' . number of characters read, or YY_NULL, 

— is returned in 'result' . 

procedure YY_INPUT (buf : out unbounded_character_array ; 
result: out integer; max_size: in integer) is 
c : character; 
i : integer := 1; 
loc ; integer := buf' first; 
begin 

while ( i <= max_size ) loop 

if (end_of_line) then — Ada ate our newline, put it back on the end. 
buf (loc) ;= ASCII .LF; 
skip_line ( 1) ; 

else 
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get (buf ( loc) ) ; 



end if; 

loc := loc + 1; 
i := i t 1; 
end loop; 

result := i - 1; 
exception 

when END_ERROR => result ;= i - 1; 

— when we hit EOF we need to set yy_eof _has_been_seen 
yy_eof _has_been_seen := true; 

end YY_INPUT; 

— yy_get_next_buf f er - try to read in new buffer 

— returns a code representing an action 

EOB_ACT_LAST_MATCH - 

— EOB_ACT_RESTART_SCAN - restart the scanner 
EOB_ACT_END_OF_FILE - end of file 

function yy_get__next__buf f er return eob__act ion__type is 
dest : integer := 0; 

source : integer := yytext_ptr - 1; — copy prev . char, too 

number_to_move : integer; 
ret_val : eob_act ion_type; 
num_to_read : integer; 
begin 

if ( yy_c__buf__p > yy_n_chars + 1 ) then 
raise NULL_IN_INPUT ; 
end if; 

— try to read more data 

— first move last chars to start of buffer 
number_to_move := yy_c_buf_p - yytext_ptr; 

for i in 0 .. number __to_move - 1 loop 

yy_ch_buf (dest) := yy_ch_buf (source) ; 
dest := dest + 1; 
source := source + 1; 
end loop; 

if ( yy_eof_has_been_seen ) then 

— don't do the read, it's not guaranteed to return an EOF, 

— just force an EOF 

yy_n_chars := 0; 
else 

num_to_read := YY__BUF_SIZE - number_to_move - 1; 

if ( num_to_read > YY_READ_BUF_SIZE ) then 
num_to_read := YY_READ_BUF_SIZE; 
end if; 
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— read in more data 

YY_INPUT ( yy_ch_buf ( number_t o_move . .yy_ch_buf' last) , 
yy^n_chars, num_to_read ); 

end if; 

if ( yy_n_chars = 0 ) then 
if ( number_to_move = 1 ) then 

ret_val := EOB_ACT_END_OF_FILE; 

else 

ret_val := EOB_ACT_LAST_MATCH; 
end if; 

yy_eof _has_been_seen := true; 
else 

ret_val := EOB_ACT_RESTART_SCAN; 
end if; 

yy n chars := yy_n_chars + number_to_move; 
yy_ch_buf (yy_n_chars) := YY_END_OF_BUFFER_CHAR; 
yy_ch_buf (yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR; 

— yytext begins at the second character in 

— yy ch_buf; the first character is the one which 

— preceded it before reading in the latest buffer; 

— it needs to be kept around in case it' s a 

— newline, so y y_get_previous_state ( ) will have 

— with rules active 

yytext_ptr := 1; 

return ret^val; 
end yy_get_next_buf f er ; 

procedure yyunput ( c ; character; yy_bp : in out integer ) is 

number_t o_move : integer; 

dest : integer; 

source : integer; 
tmp_yy_cp : integer; 
begin 

tmp_yy_cp := yy_c_buf_p; 

yy_ch_buf (tmp_yy_cp) := yy_hold_char ; — undo effects of setting up yytext 

if ( tmp_yy_cp < 2 ) then 

— need to shift things up to make room 

number_to_move := yy_n_chars + 2; — +2 for EOB chars 

dest := YY_BUF_SIZE + 2; 

source ;= n umber _to_move; 

while ( source > 0 ) loop 
dest := dest - 1; 
source := source - 1; 

yy_ch_buf (dest) := yy_ch_buf (source) ; 
end loop; 

tmp_yy_cp := tmp_yy_cp + dest - source; 
yy_bp := yy_bp + dest - source; 
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yy_n_chars := YY_BUF_SIZE; 

if ( tmp_yy_cp < 2 ) then 

raise PUSHBACK^OVERFLOW; 
end if; 
end if; 

if ( tmp_yy_cp > yy_bp and then yy_ch_buf ( tmp_yy_cp-l ) = ASCII. LF 
yy_ch_buf ( tmp_yy_cp-2 ) := ASCII. LF; 

end if; 

tmp_yy_cp := tmp_yy_cp - 1; 
yy_ch_buf (tmp_yy_cp) c; 

— Note: this code is the text of YY_DO_BEFORE_ACTION, only 

— here we get different yy_cp and yy_bp' s 
yytext_ptr := yy_bp; 

yy_hold_char := yy_ch_buf (tmp_yy_cp) ; 
yy_ch_buf (tmp_yy_cp) ;= ASCII. NUL; 
yy_c_buf_p := tmp_yy_cp; 
end yyunput; 

procedure unput (c : character) is 

begin 

yyunput ( c, yy_bp ) ; 
end unput; 

function input return character is 
c : character; 

yy_cp : integer := yy_c_buf_p; 

begin 

yy_ch_buf (yy_cp) := yy_hold_char ; 

if ( yy_ch_buf (yy_c_buf_p) = YY_END_OF_BUFFER_CHAR ) then 
— need more input 
yytext_ptr := yy_c_buf_p; 
yy_c_buf_p := yy_c_buf_p + 1; 

case yy_get_next_buf f er is 

— this code, unfortunately, is somewhat redundant with 

— that above 

when EOB_ACT_END_OF_FILE => 
if ( yywrap ) then 

yy_c_buf_p := yytext_ptr; 
return ASCII. NUL; 
end if; 

yy_ch_buf(0) := ASCII. LF; 
yy_n_chars := 1; 

yy_ch_buf (yy_n_chars) := YY_END_OF_BUFFER_CHAR; 
yy_ch_buf (yy_n_chars + 1) := YY_END_OF_BUFFER_CHAR; 

yy_eof_has_been_seen := false; 
yy_c_buf_p := 1; 
yytext_ptr := yy_c_buf_p; 



then 
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yy_hold_char ;= yy_ch__buf (yy_c_buf_p) ; 

return ( input ) ; 

when EOB_ACT_RESTART_SCAN => 

yy__c_buf_p ;= yytext_ptr; 

when EOB_ACT_LAST_MATCH => 
raise UNEXPECTED_LAST_MATCH; 
when others => null; 
end case; 
end if; 

c := yy__ch_buf (yy_c_buf_p) ; 
yy_c_buf_p := yy_c_buf_p + 1; 
yy_hold_char := yy_ch__buf (yy_c_buf_p) ; 

return c; 
end input; 

procedure output (c : character) is 

begin 

text_io.put (c) ; 
end output; 

— default yywrap function - always treat EOF as an EOF 

function yywrap return boolean is 

begin 

return true; 
end yywrap; 

procedure Open_Input (fname : in String) is 
f : file_type; 
begin 

yy_init := true; 
open (f , in_f ile, fname) ; 
set_input ( f ) ; 
end Open_Input; 

procedure Create_Output (fname : in String := "") is 
f : file^type; 
begin 

if (fname /= "") then 

create (f , out_file, fname) ; 
set_output (f ) ; 
end if; 

end Create_Output ; 

procedure Close_Input is 
begin 

null ; 

end Close_Input; 

procedure Close_Output is 
begin 

null ; 
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end Close_Output ; 



end psdl_lex_io; 
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APPENDIX T. PACKAGE PSDL LEX DFA 



package psdl_lex_dfa is 
aflex_debug : boolean ;= false; 

yytext_ptr : integer; — points to start of yytext in buffer 

— yy_ch_buf has to be 2 characters longer than YY_BUF_SIZE because we need 

— to put in 2 end-of -buf f er characters (this is explained where it is 

— done) at the end of yy_ch_buf 

YY_READ_BUF_SIZE ; constant integer := 8192; 

YY_BUF_SIZE : constant integer := YY_READ_BUF_SI ZE * 2; — size of input buffer 
type unbounded_character_array is array ( integer range <>) of character; 
subtype ch_buf_type is unbounded_character_array (0 . . YY_BUF_SIZE + 1); 
yy^ch^buf : ch_buf_type; 
yy_cp, yy_bp : integer; 

— yy_hold_char holds the character lost when yytext is formed 

yy_hold_char : character; 

yy^c_buf_p : integer; — points to current character in buffer 

function YYText return string; 
function YYLength return integer; 
procedure YY_D0_BEF0RE_ACTI0N; 

— These variables are needed between calls to YYLex. 

yy_init : boolean := true; — do we need to initialize YYLex? 

yy_start : integer := 0; — current start state number 

subtype yy_state_type is integer; 

yy_last_accept ing_st ate : yy_state_type ; 

yy_last_accept ing^cpos ; integer; 

end psdl_lex_df a; 

with psdl_lex_df a; use psdl_lex_df a; 
package body psdl_lex_dfa is 
function YYText return string is 
i : integer; 
str^loc ; integer := 1; 
buffer : string ( 1 . . 1 02 4 ) ; 

EMPTY_STRING : constant string := 
begin 

— find end of buffer 
i := yytext_ptr; 

while ( yy_ch_buf(i) /= ASCII. NUL ) loop 
buf f er (str_loc ) := yy_ch_buf (i) ; 

i :=i+l; 

str_loc := str_loc + 1; 
end loop; 

— return yy_ch_buf (yytext_ptr. . i - 1) ; 

if (str_loc < 2) then 

return EMPTY_STRING; 

else 
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end; 



return buf f er ( 1 . . str_loc-l ) ; 
end if; 



— returns the length of the matched text 
function YYLength return integer is 
begin 

return yy_cp - yy_bp; 
end YYLength; 

— done after the current pattern has been matched and before the 

— corresponding action - sets up yytext 

procedure YY_DO_BEFORE_ACTION is 
begin 

yytext_ptr := yy_hp; 
yy_hold_char := yy_ch_buf (yy_cp) ; 
yy_ch_buf (yy_cp) := ASCII.NUL; 
yy_c_buf_p := yy_cp; 
end YY_DO_BEFORE_ACTION; 

end psdl_lex_df a ; 
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APPENDIX U. PACKAGE PARSER 



— $source: /n/gemini/work/bayram/AYACC/parser/RCS/psdl . y, v $ 

— $date: 1991/08/28 10:04:49 $ 

— $revision: 3.3 $ 

— $log: Psdl.Y,V $ 



Package Spec PARSER 



with Text_Io, Psdl_Component_Pkg, Psdl_Concrete_Type_Pkg, Stack_Pkg, 
Psdl_Graph_Pkg, Generic_Sequence_Pkg, A_Strings/ 
use Psdl_Component_Pkg, Psdl_Concrete_Type_Pkg, Psdl_Graph_Pkg; 

package Parser is 



— Global Variable Which Is A Map From P sdl_Component Names To Psdl 

— Component Definitions 

The^Program — Implemented 

: Psdl_Program; 



— Global Variable For A Psdl_Component (Type Or Operator) 

The_Component — Implemented 

: Psdl^Component ; 



— Global Variable Which Points To The Psdl_Component (Type Or Operator) 

The_Component_Pt r — Implemented 

: Component_Pt r; 



— Global Variable Which Points To The Psdl Operator (Type Or Operator) 

The_Op_Ptr — Implemented 

: Op_Ptr; 

— used to construct the operation map 
The_Operator : Operator; 

— Global Variable For An Atomic Type — Implemented 
The_At omic_Type 
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: At omic_Type ; 



— Global Variable For An Atomic Operator 



The Atomic Operator 
: Atomic Operator; 


— Implemented 



— Global Variable For A Composite Psdl Type 



The Composite Type 
: Composite Type; 


— Implemented 



— Global Variable For A Composite Psdl Type 



The_Composite Operator 
: Composite Operator; 


-- Implemented 



— /* Global Variables For All Psdl Components: */ 



— Global Variable Which 


Holds The Name Of The Component 


The Psdl Name 
: Psdl_Id; 


— Implemented 


— Global Variable Which 


Holds The Ada Id Variable Of Component Record 


The Ada Name 
: Ada_Id; 


— Implemented 


— Global Variable Which 


Holds The Generic Parameters 


The Gen Par 

: Type Declaration; 


— Implemented 


-- used for psdl type part 


(for not to mix with operation map) 



The_Type_Gen_Par : Type_Declarat ion; 



— Global Variable Which 


Holds The Keywords 


The Keywords 
: Id_Set; 


— Implemented 


The Description 
: Text; 


— Implemented 


The Axioms 
: Text; 


— Implemented 



— A Temporary Variable To Hold Output_Id To Construct Out_Guard Map 

The_Output_Id 
: Output_Id; 

— A Temporary Variable To Hold Excep_Id To Construct Excep_Trigger Map 
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The_Excep_Id 
: Excep_Id; 

— Global Variables For All Psdl Types: 

— Used For Creating All Types 
The_Model 

; Type_Declaration ; 

The_Operat ion_Map 
; Operat ion_Map; 

— Used For Creating Composite Types 

The_Data_St ructure 
: Type_Name; 



— Global Variables For All Operators: 
The_Input 

: Type_Declaration ; 

The_Output 

: Type_Declaration ; 

The_St ate 

: Type^Declaration ; 

The_Init ial_Expression 
: Init_Map; 

The_Exceptions 
: Id_Set; 

The_Specif ied_Met 
: Mi 1 1 i s e c / 

— Global Variables For Composite Operators: 

The_Graph 

: Psdl_Graph; 

The_St reams 

: Type_Declaration; 

The_Timers 
; Id_Set; 

The_Trigger 

: Trigger_Map; 



- Implemented 



— Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 



- Implemented 
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— Implemented 



The_Exec_Guard 

: Exec_Guard_Map ; 



The_Out_Guard 

: Out_Guard_Map; 



-- Implemented 



The_Excep_T rigger 

: Excep_Trigger_Map; 



— Implemented 



The_Timer_Op 

: Timer_Op_Map; 



Implemented 



The_Per 

: Timing_Map; 



— Implemented 



The_Fw 

: Timing_Map; 



— Implemented 



The_Mcp 

: Timing_Map; 



— Implemented 



The Mrt 



-- Implemented 



: Timing_Map; 

The_Impl_Desc 

: Text := Empty_Text; 

— Is Used For Storing The Operator Names In Control Constraints Part 

The_Operator_Name 
: Psdl_Id; 

— A Place Holder To For Time Values 

The_Time 

: Mi 1 1 i s e c ; 

— True If The Psdl_Component Is An Atomic One 

Is_Atomic_Type — Implemented 

: Boolean; 

Is_Atomic_Operator : Boolean; 

— Holds The Name Of The Edge (I.E Stream Name) 

The_Edge_Name — Implemented 

: Psdl_Id; 
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— Renames The Procedure Bind In Generic Map Package 

— Psdl Program Is A Mapping From Psdl Component Names . . 

— . . To Psdl Component Definitions 

Procedure Bind_Program 
( Name : In Psdl_Id; 

Component : In Component^Pt r ; 

Program : In Out 

Psdl_Program ) 

Renames Bind/ 



— Renames The Procedure Bind In Generic Map Package 

— Psdl Program Is A Mapping From Psdl Id' S To Psdl Type Names 

Procedure Bind_Type_Decl_Map 
( Key ; In Psdl_Id; 

Result : In Type_Name; 

Map : In Out 

Type_Declaration ) 

Renames Type_Declaration_Pkg . 

Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Operation Map Is A Mapping From Psdl Operator Names To Psdl . 

— .. Operator Definitions. 

Procedure Bind__^Operation 
( Key : In Psdl_Id/ 

Result : In Op__^Ptr; 

Map : In Out Operation_Map ) 

Renames Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Trigger Map Is A Mapping From Psdl Operator Names To Trigger 

— . . Types (By Some, By All, None . . 

Procedure Bind_Trigger 
( Key : In Psdl^Id; 

Result : In Trigger_Record; 

Map : In Out Trigger_Map ) 

Renames Trigger_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

-- Timing Map Is A Mapping From Psdl Operator Names To 

— .. Some Timing Parameters (Per, Mrt, Fw, Mcp, ...) 

Procedure Bind_Timing 
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( Key : In Psdl_Id; 

Result : In Millisec; 

Map : In Out Timing_Map ) 

Renames Timing_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Out_Guard Map Is A Mapping From Output Stream Id' S To 

— . . Expression Strings 

Procedure Bind_Out_Guard 
( Key : In Output_Id; 

Result : In Expression; 

Map : In Out Out_Guard_Map ) 

Renames Out_Guard_Map_Pkg . Bind; 



-- Renames The Procedure Bind In Generic Map Package 
— Init_Map Is A Mapping From Psdl Id'S To . , 

-- . . Expression Strings 

Procedure Bind_Init_Map 
( Key : In Psdl_Id; 

Result : In Expression; 

Map : In Out Init_Map ) 

Renames Init_Map_Pkg . Bind; 



-- Renames The Procedure Bind In Generic Map Package 

— Timer_Op_Map Is A Mapping From Psdl Id'S To .. 

— . , Timer_Op_Set 

Procedure Bind_Timer_Op 
( Key : In Psdl_Id; 

Result : In Timer_Op_Set ; 

Map : In Out Timer_Op_Map ) 

Renames Time r_Op_Map_Pkg . Bind; 



— Renames The Procedure Bind In Generic Map Package 

— Exception Trigger Map Is A Mapping From Psdl Id'S To 

— . . Expression Strings 

Procedure Bind_Excep_Trigger 
( Key : In Excep^Id; 

Result : In Expression; 

Map : In Out 

Excep_Trigger_Map ) 



338 



Renames Excep_Trigger_Map_Pkg . 
Bind ; 



— Renames The Procedure Bind In Generic Map Package 

— Exec_Guard Map Is A Mapping From Psdl Id'S To . . 

— . . Expression Strings 

Procedure Bind_Exec_Guard 
( Key : In Psdl_Id; 

Result : In Expression; 

Map : In Out Exec_Guard_Map 

) 

Renames Exec_Guard_Map_Pkg .Bind; 



— Implements A Temporary Storage For Type Declaration. 

Package Type_Decl_St ack_Pkg Is 

New Stack_Pkg (Type_Declarat ion) 



Use Type_Decl_Stack_Pkg; 

Subtype Type_Decl_St ack Is 
Type_Decl_Stack_Pkg . Stack; 

— A Stack Declaration And Initialization For Type_Declaration 

The_Type_Decl_Stack 
: Type_Decl_Stack := 

Type_Decl_St ack_Pkg . Create ; 



Package Id_Set_Stack_Pkg Is 
New Stack^Pkg (Id^Set) ; 

Subtype Id_Set_Stack Is 
Id_Set_Stack_Pkg . Stack; 

-- A Stack Declaration And Initialization For Id 

The_Id_Set_Stack 
: Id_Set_Stack := 

Id_Set_Stack_Pkg .Create ; 

— Global Declaration For Type_Id_Set 
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— Implemented 



The_Id_Set 
: Id_Set; 



The_Id_Set_Size 
: Natural; 



Package Expression_Stack_Pkg Is 
New Stack_Pkg (Expression) ; 

Subtype Expression_Stack Is 
Expression_Stack_Pkg . Stack ; 

— A Stack Declaration And Initialization For Id 

The_Expres sion^Stack 
: Expression_Stack := 

Expression_Stack_Pkg .Create; 



Package Exp_Seq_Pkg Is 

New Generic_Sequence_Pkg (T => 
Expression, Block_Size => 24 
) / 



Subtype Exp_Seq Is 

Exp_Seq_Pkg . Sequence ; 

— returns an empty expression sequence 
function Empty_Exp_Seq return Exp_Seq; 

The_Exp_Seq 
: Exp_Seq; 



The_Init_Expr_Seq : Exp_Seq; — Used For Constructing Init_Map 
Temp_Init_Expr_Seq : Exp_Seq; 

package Init_Exp_Seq_Stack_Pkg is 
new Stack_Pkg (Exp_Seq) ; 

subtype Init_Exp_Seq_Stack is Init_Exp_Seq_Stack_Pkg . Stack ; 
The_Init_Exp_Seq_Stack ; 

Init_Exp_Seq_Stack := In it_Exp_Seq_Stack_Pkg .Create; 



Procedure Remove_Expr_From_Seq Is 

New Exp_Seq_Pkg . Generic_Remove (Eq => "=") ; 



Package Id_Seq_Pkg Is 
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=> Psdl Id, 



New Generic_Sequence_Pkg (T 
Block_Size => 24); 

Subtype Id^Seq Is 

Id_Seq_Pkg . Sequence; 

The_Id_Seq 
: Id_Seq; 



The_Init_Map_Id_Seq : Id^Seq; — to hold the id's to construct init map 

— these are the same id's used in state map. 



— Holds The Name Of The Types; 

The_Type_Name 
: Type_Name; 

— Used For The Type Decl Part Of Type_Name 
The_Type_Name_Decl ; Type_Declaration ; 



— A Temporary Type_Decl 
Temp_Type_Decl 

: Type^Declaration; 

— A Temporary Variable For Holding The Identifiers 

The^String 
; Psdl_Id; 

— A Temporary Variable For Trigger_Record 

The_Trigger_Record 
; Trigger_Record ; 

— A Temp Variable For Holding The Value Of Timer_Op 

The_Timer_Op_Record 
: T i me r_Op ; 

Th e_T i me r_Op_S e t 
: Timer_Op_Set ; 

— A Temp Variable For Producing The Expression String 

The_Expression_String 

: Expression := Expression ( 

A_St rings . Empty ) ; 
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— A Temp Variable For Producing The Time String 



The_Time_String 

: Expression := Expression ( 

A^Strings . Empty ) ; 

Echo 

: Boolean ;= False; 

Number__Of_Errors 
: Natural := 0/ 

Semantic_Error : Exception; 

Procedure Yyparse; 

procedure GET (Item : out PSDL_PROGRAM) ; 



procedure GET ( Input__File_N : in String; 

Output_File_N ; in String ;= 

Item : out PSDL__PROGRAM) ; 



end Parser; 



Package body PARSER 



with Psdl_Tokens, Psdl_Goto, 

Psdl_Shif t_Reduce, Psdl_Lex, 
Text_Io, Psdl_Lex_Df a, 
Psdl_Lex_Io, A_Strings, 
Psdl_Concrete_Type_Pkg, 
Psdl_Graph_Pkg, 
Generic_Sequence_Pkg; 

use Psdl_Tokens, Psdl_Goto, 

Psdl^Shif t_Reduce, Psdl_Lex, 
Text_Io, 

Psdl_Concrete_Type_Pkg, 

Psdl_Graph_Pkg; 



package Body Parser is 

— this flag is set to true when opt ional_generic_param 

— rule is parsed, to overcome the problem when two 
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— id's come after one another. See psdl_lex.l file 
Type_Spec_Gen_Par : Boolean := FALSE; 

— function Empty_Exp_Seq 



function Empt y_Exp_Seq return Exp_Seq is 
S : Exp_Seq ; 
begin 

Exp_Seq_Pkg . Empty ( S) ; 
return S; 

end Empt y_Exp_Seq; 



— Procedure Yyerror 



procedure Yyerror 
( S : In String := 

"Syntax Error" ) is 
Space 

: Integer; 

begin — Yyerror 

Number_Of_Errors := 

Number_Of_Errors + 1; 
Text_I o . New_Line ; 

Text_Io . Put ( "Line" & Integer' 
Image (Lines - 1) & ") ; 

Text_Io . Put_Line (Psdl_Lex_Df a , 
Yytext) ; 

Space := Integer (Psdl_Lex_Df a , 
Yytext ' Length ) + Integer' 

Image (Lines) ' Length + 5; 
for I In 1 . . Space loop 

Put ("-") ; 
end loop; 

Put_Line("" " & S) ; 
end Yyerror; 



— function Convert_To_Digit 

— Given A String Of Characters Corresponding To A Natural Number, 

— Returns The Natural Value 



function Convert_To_Digit 
( String_Digit : String ) 
Return Integer Is 
Multiplier 

: Integer ;= 1; 

Digit, Nat_Value 
: Integer := 0; 
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Begin -- Conve rt_To_Digit 
For I In Reverse 1 . . 

St ring_Digit ' Length Loop 

Case St ring_Di git ( I ) Is 

When '0' => 

Digit := 0; 

When '1' => 

Digit := 1; 

When '2' => 

Digit := 2; 

When '3' => 

Digit := 3; 

When M' => 

Digit := 4; 

When '5' => 

Digit ;= 5; 

When '6' => 

Digit ;= 6/ 

When '7' => 

Digit := 7; 

When '8' => 

Digit := 8; 

When '9' => 

Digit := 9; 

When Others => 

Null; 

End Case; 

Nat_Value := Nat_Value + ( 

Multiplier ^ Digit) ; 

Multiplier := Multiplier ^ 10; 
End Loop; 

Return Nat_Value; 
end Convert_To_Digit ; 



— procedure GET 

— Reads the psdl source file, parses it and creates the PSDL ADT 

-- Input file is line numbered and saved into a file 

— input file name .1st in the current directory. So if 

— there is no write permission for that directory, exception 

— Use_Error is raised and program aborts, if the second argument 

— is passed psdl file resulted form PSDL ADT is written into a 

file with that name . 



procedure GET ( Input_File_N : in String; 
Output_File_N : in String := 

Item : out PSDL_PROGRAM ) is 

begin 
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Psdl_Lex_Io . Open_Input ( Input_File_N) ; 
if Output_File_N /= "" then 

Psdl_Lex_Io . Create_Output (Output_File_N) ; 
el se 

P sd l_Le x_I o . C re at e_Ou tp ut ; 
end if; 

Text_Io . Create (Psdl_Lex . List_File, Out_File, Input_File_N & ".1st"); 
Psdl_Lex . Linenum; 

YYParse; 

Psdl_Lex_I o . Close_Input ; 

Psdl_Lex_I o . Close_Output ; 

Item := The_Program; 

Text lo. Close (Psdl_Lex . List_File) ; 



— procedure GET — 

— Reads the standard input, parses it and creates the -- 

— PSDL ADT . Input file is line numbered and saved into a 
file input file name .1st in the current directory. So if 

-- there is no write permission for that directory, exception -- 

— Use_Error is raised and program aborts. 



procedure GET (Item : out PSDL_PROGRAM) is 
begin 

Text_Io . Create (Psdl_Lex . List_File, Out_File, "stdin . psdl . 1st") ; 
Psdl_Lex .Linenum; 

YYParse; 

Psdl_Lex_^I o . Close_Input ; 

Psdl_Lex_Io . Close_Output ; 

Item := The_Program; 

Text^I o . Close ( Psdl^Lex . List_File ) ; 

end Get; 



procedure Bind_Type_Declarat ion 

— /* Bind Each Id In Id The Id */ 

— /* Set To The Type Name */ 

— /* Return Temp_Type_Decl */ 
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Id_Set ; 



Procedure Bind_Type_Declaration ( I_S : In 

Tn : In Type_Name; 

Td : in out Type_Declaration) is 

begin 

— /* m4 code 

““/* foreach([Id: Psdl_Id] , [ Id_Set_Pkg . Generic_Scan] , 

— /* [I_s], 

— /* [ 

— /* Bind_Type_Decl_Map ( Id, Tn, Td) ; 

— ]) 

— / ■* Begin expansion of FOREACH loop macro, 
declare 

procedure Loop_Body ( Id : Psdl_Id) is 
begin 

Bind_Type_Decl_Map ( Id , Tn, Td) ; 

end Loop_Body; 
procedure Execute_Loop is 
new Id_Set_Pkg . Generic_Scan (Loop_Body ) ; 
begin 

execute_loop (I_s) ; 
end; 

— /* end of expansion of FOREACH loop macro, 
end Bind_Type_Declarat ion; 



— procedure Bind_Initial_State 

— /* Bind Each Id In the State map domain 
— /* Set To The Type Name initial expression 



procedure Bind_Initial_State ( State : in Type^Declarat ion; 

Init_Seq : in Exp^Seq; 

Init_Exp_Map ; out Init_Map) is 
i : Natural := 1; 



— /* 
— /* 

— /* 

— n 

— /* 
— /* 
— /* 



— /+ M 4 macro code for binding each initial expression in — /* 

— /* the_init_expr_seq to the id's in state declaration map — /* 

foreach([Id: in Psdl^Id; Tn: in Type_Name] , — /* 

[ Type_Declaration_Pkg . Generic_Scan] , — /* 

[State ] , — / * 



[ 

Bind_Init_Map ( Id, Exp_Seq_Pkg . Fetch (The_Init_Exp_Seq, i) 
The_Initial_Expression) ; — /* 

i : = i + 1 ; 

] ) 



— /* 
— /* 



begin 



— Begin expansion of FOREACH loop macro, 
declare 

procedure Loop_Body ( Id : in Psdl_Id; Tn : in Type_Name) is 
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begin 



if i > Exp_Seq_Pkg . Length (The_Init_Expr_Seq) then 

Yyerror ( "SEMANTIC ERROR ~ Some states are not initialized."); 
Raise SEMANTIC_ERROR; 
else 

Bind_Init_Map ( Id, Exp_Seq_Pkg . Fetch (The_Init_Expr_Seq, i) , 
The_Init ial_Expression ) ; 
i : = i + 1 ; 



end Loop_Body; 

procedure execute_loop is new Type_Declarat ion_Pkg . Generic_Scan (Loop_Body ) ; 
begin 

execute_loop (State) ; 
end; 

-- LIMITATIONS: Square brackets are used as macro quoting characters, 
so you must write [[x]] in the m4 source file 

— to get [x] in the generated Ada code. 

— Ada programs using FOREACH loops must avoid the lower case spellings of 

— the identifier names "DEFINE", "UNDEFINE", and "DNL", 

— or must quote them like this: [define] . 

— The implementation requires each package to be generated by 
-- a separate call to m4 : put each package in a separate file. 

— Exit and return statements inside the body of a FOREACH loop 

— may not work correctly if FOREACH loops are nested. 

— An expression returned from within a loop body must not 

— mention any index variables of the loop. 

— End expansion of FOREACH loop macro. 

— if number if initial states > number of states, raise exception 

— and abort parsing 

if (i-1) < Exp_Seq_Pkg . Length (The_I nit_Expr_Seq) then 

Yyerror ( "SEMANTIC ERROR - There are more initializations than the states"); 
raise SEMANTIC_ERROR; 
end if; 

end Bind__I nitial_State ; 



end if; 



procedure Make_PSdl_Type 



construct the PSDL TYPE using global variables 



procedure Build_PSdl_Type 



(C_Name 

C_a_Name 

Mdl 

D_Str 

Ops 

G_Par 

Kwr 



: in Psdl_Id; 

: in Ada^Id; 

: in Type_Declaration ; 

: in Type_Name; 

: in Operat ion_Map; 

: in out Type_Declaration; 
: in out Id_Set; 

: in out Text; 

; in out Text; 

: in Boolean; 



I_Desc : 
F_Desc 
Is Atomic: 



347 



begin 



The_Type ; in out Data_Type) 



IS 



if IS_ATOMIC then 

The_Type := Make_Atomic_Type 
( Psdl_Name => C_Name, 
Ada_Name => C_A_Name , 
Model => Mdl, 

Gen_Par => G_Par, 
Operations=> Ops, 
Keywords => Kwr, 

Inf ormal_De script ion 
=> I_Desc, 

Axioms => F_Desc ) ; 



else 

The_Type : = Make_Compo site_Type 
( Name => C_Name, 

Model => Mdl, 

Dat a_St ruct ure 
=> D_Str, 

Operations=> Ops, 

Gen_Par => G_Par, 

Keywords => Kwr, 

Inf ormal_De script ion 
=> I_Desc, 

Axioms => F_Desc ) / 

end if; 

— /* After constructing the component */ 

— /* initialized the global varibales for / 

— /* optional attributes */ 

G_Par := Empty_Type_Declaration; 

Kwr := Empty_Id_Set ; 

I__Desc := EMpty_Text; 

F_Desc := EMpty_Text; 

end Build_PSdl_Type; 



procedure Build_PSdl_Operator 
construct the PSDL OPERATOR using global variables 



procedure Build_PSdl_Operator 



(C Name 


: in 


Psdl 


_Id; 


C a Name 


: in 


Ada 


_Id; 


G_Par 


: in 


out 


Type Declaration; 


Kwr 


: in 


out 


Id_Set; 


I Desc 


: in 


out 


Text; 


F Desc 


: in 


out 


Text; 
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Inp 


in 


out 


Type Declaration; 


Otp : 


in 


out 


Type Declaration; 


St : 


in 


out 


Type Declaration; 


I Exp Map: 


in 


out 


I nit Map; 


Excps : 


in 


out 


Id_Set; 


S_MET : 


in 


out 


Millisec; 


Gr : 


in 


out 


Psdl Graph; 


D Stream : 


in 


out 


Type Declaration; 


Tmrs : 


in 


out 


Id_Set; 


Trigs : 


in 


out 


Trigger_Map; 


E_Guard : 


in 


out 


Exec Guard^Map; 


0 Guard : 


in 


out 


Out Guard Map; 


E Trigger: 


in 


out 


Excep_Trigger Map 


T_Op : 


in 


out 


Timer Op Map; 


Per : 


in 


out 


Timing Map; 


Fw : 


in 


out 


Timing Map; 


Mcp 


in 


out 


Timing Map; 


Mrt : 


in 


out 


Timing Map; 


Im Desc : 


in 


out 


Text; 


IS_ATOMIC: 


in 


Boolean; 


The Opr : 


in 


out 


Operator) is 



begin 

if IS_ATOMIC then 

The_Opr Make_At omic_Operator 
( Psdl_Name => C_Name, 

Ada_Name => C_A_Name, 
Gen_Par => G_Par, 

Keywords => Kwr, 

Inf ormal_Descr iption 
=> I_Desc, 

Axioms => F_Desc, 

Input => Inp, 

Output => Otp, 

State => St, 

Initialization_Map 
=> I_Exp_Map, 

Exceptions => Excps, 

Specif ied_Met => S_MET) ; 

else 

The_Opr := Make_Composite_Operat or 
( Name => C_Name, 

Gen_Par => G_Par, 

Keywords => Kwr, 

Inf orm a l_De script ion 
=> I_Desc, 

Axioms => F_Desc, 

Input => Inp, 

Output => Otp, 

State => St, 

Initializat ion_Map 
=> I_Exp_Map, 

Exceptions => Excps, 

Specif ied_Met => S_Met, 

Graph => Gr, 
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Streams => D_Stream, 

Timers => Tmrs, 

Trigger => Trigs, 

Exec_Guard=> E_Guard, 
Out_Guard => 0_Guard, 
Excep_Trigger => E_Trigger, 



Timer_Op 

Per 

Fw 

Mcp 

Mrt 



=> T_Op, 
= > Per, 

= > Fw, 

=> Mcp, 
=> Mrt, 



Impl_Desc => Im_Desc) ; 



end if; 



-- /* After constructing the component */ 

— /■* initialized the global varibales for */ 

— /* optional attributes */ 



G_Par 


= Empty Type Declaration; 


Kwr 


= Empty Id Set; 


I De sc 


= EMpty Text; 


F De sc 


= EMpty Text; 


Inp 


= Empty Type Declaration; 


Otp 


= Empty^Type Declaration; 


St 


= Empty Type Declaration; 


I Exp Map 


= Empty I nit Map; 


Excps 


= Empty_Id_Set ; 


S_Met 


= 0; 


Gr 


= Empty Psdl Graph; 


D Stream 


= Empty Type Declaration; 


Tmrs 


- Empt y_Id_Set ; 


Trigs 


= Empty Trigger Map; 


E Guard 


= Empty Exec Guard Map; 


0_Guard 


= Empty_Out_Guard_Map; 


E_Trigger 


- Empty Excep Trigger Map 


T_Op 


= Empty Timer Op Map; 


Per 


= Empty Timing Map; 


F w 


= Empty Timing Map; 


Mcp 


= Empty Timing Map; 


Mrt 


= Empty Timing Map; 


Im Desc 


= EMpty_Text; 



end Build_Psdl_Operator; 



— procedure Add_Op_Impl_To_Op_Map - 

— Uses the operation map we cunstructed only with the - 

— specification part. - 

— Fetchs the operator from the map, uses to create a new one- 

— with it (specification part) and add the implementation - 

— to it . - 
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Remove the old one, and add the new complete operator the 
map . 



Add_Op Impl_ 


To_ 


Op Map (Op Name : in 


A Name : 


in 


Ada 


_Id; 


Is Atomic : 


in 


Boolean; 


0_Map : 


in 


out 


Operation Map; 








Gr : in 


D_Stream : 


in 


out 


Type Declaration; 


Tmrs : 


in 


out 


Id_Set; 


Trigs : 


in 


out 


Trigger Map; 


E Guard : 


in 


out 


Exec Guard Map; 


0 Guard : 


in 


out 


Out Guard Map; 


E Trigger ; 


in 


out 


Excep Trigger_Map; 


T_Op 


in 


out 


Timer Op Map; 


Per 


in 


out 


Timing Map; 


Fw 


in 


out 


T iming_Map; 


Mep 


in 


out 


Timing_Map; 


Mrt : 


in 


out 


Timing Map; 


Im Desc : 


in 


out 


Text ) is 



in Psdl Id; 



Temp_Op : Operator; 

Temp_Op_Ptr : Op_Ptr; 

begin 

if Ope ration_Map_Pkg . Member (Op_Name, Operation_Map_Pkg . Map (0_Map) ) then 
Temp_Op := 

Operation_Map_Pkg .Fetch (Operation_Map_Pkg .Map (0_Map) , Op_Name) . all 
Operation_Map_Pkg .Remove (Op_Name, Operation_Map_Pkg . Map (0_Map) ) ; 
if Is_Atomic then 

Temp_Op := Make_Atomic_Operator 
(Psdl_Name => Op_Name, 

Ada_Name => A_Name, 

Gen_Par => Gener ic_Paramet ers ( Temp_Op) , 

Keywords => Keywords ( Temp_Op) , 

Inf ormal_De script ion 

=> Inf ormal_Description (Temp_Op) , 

Axioms => Axioms (Temp_Op) , 

Input => Input s ( Temp_Op) , 

Output => Outputs (Temp_Op) , 

State => States ( Temp_Op) , 

Initialization_Map 

=> Get_Init_Map ( Temp_Op) , 

Exceptions=> Exceptions ( Temp_Op) , 

Speer fied_Met => 

Specif ied_Maximum_Execution_Time (Temp_Op) ) ; 



Temp_Op_Ptr := new Operator (Category 
Granularity => Atomic) ; 
Temp_Op_Pt r . all := Temp_Op; 



=> Psdl_Operator, 



else 

Temp_Op := Make_Composite_Operat or 

(Name => Op_Name, 
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Gen Par 



=> Generic_Parameters ( Temp_Op) , 

Keywords => Keywords (Temp_Op) , 

Inf ormal^De script ion 

=> Inf ormal_Descript ion ( Temp_Op) , 
Axioms => Axioms (Temp_Op) , 

Input => Inputs (Temp_Op) , 

Output => Outputs (Temp_Op) , 

State => State s ( Temp_Op) , 

Initial! 2 at ion_Map 

=> Get_Init_Map ( Temp_Op) , 

Exceptions=> Exceptions ( Temp_Op) , 

Specif ied_Met => 



Exec_Guard=> 
Out_Guard => 
Ex cep_T rigger 



Timer_Op => 
Per => 
Fw => 
Mcp => 
Mrt => 



Impl_Desc => 



Specif ied_Maximum_Execution_Time ( Temp_Op) 



Graph 


=> 


Gr, 


Streams 


=> 


D Stream, 


Timers 


=> 


Tmrs, 


Trigger 


=> 


Trigs, 



E_Guard, 

0_Guard, 

=> E_Trigger, 
T_Op, 

Per, 

Fw, 

Mcp, 

Mrt, 

Im_Desc) ; 



Temp_Op_Ptr := new Operator (Category => Psdl_Operator, 
Granularity => Composite) / 

Temp_Op_Pt r . all := Temp_Op; 
end if; 

Bind_Operat ion ( Op_Name , Temp_Op_Ptr, 0_Map) / 



— reset everything after you are done. (the variables that 

— have default values) 



Gr 

D_Stream 

Tmr s 

Trigs 

E_Guard 

0_Guard 

E_Trigger 

T_Op 

Per 

Fw 

Mcp 

Mrt 

Im Desc 



= Empty_Psdl_Graph; 

= Empty_Type_Declaration; 

= Empty_Id_Set ; 

= Empty_Trigger_Map; 

= Empty_Exec_Guard_Map; 

= Empty_Out_Guard_Map; 

= Empty_Excep_Trigger_Map; 
= Empty_Timer_Op_Map; 

= Empty_Timing_Map/ 

= Empty_Timing_Map; 

= Empty_Timing_Map; 

= Empty_Timing_Map; 

= EMpty_Text; 



else 

Put ( "Warning : The specification of operator '''); 

Put_Line (Op_Name . s & was not given, implementation ignored."); 
end if; 

end Add_Op_Impl_To_Op_Map; 



procedure YYParse is 
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— Rename User Defined Packages 
package yy_got o_tables 
Psdl_Got o; 

package yy_shift_reduce_ tables 
Psdl_Shif t_Reduce ; 
package yy_tokens 
Psdl_Tokens; 



to Internal 
renames 

renames 

renames 



Names . 



use yy_tokens, yy_goto_tables , yy^shif t_reduce_tables ; 

procedure yyerrok; 
procedure yyclearin; 

package yy is 

— the size of the value and state stacks 
stack size : constant Natural := 300; 



— subtype rule is natural; 

subtype parse_state is natural; 

— subtype nonterminal is integer; 



— encryption constants 






default 


: constant 


-1; 




f irst_shif t_ent ry 


: constant 


:= 0; 




accept code 


: constant 


:= -1001; 




error code 


: constant 


:= -1000; 




— stack data used 


by the pa. 


rser 




t os 


: natural 


:= 0; 




value stack 


: array ( 0 


. . stack size ) 


of yy_tokens . yy stype 


state stack 


: array (0 


. . stack size ) 


of parse state; 


— current input symbol and . 


action the parser is on 


action 


: integer 


t 




rule id 


: rule; 






input symbol 


: yy tokens . token; 





— error recovery flag 

error_flag : natural := 0; 

— indicates 3 - (number of valid shifts after an error occurs) 

look_ahead : boolean ;= true; 
index : integer; 

— Is Debugging option on or off 
DEBUG : constant boolean := FALSE; 

end yy; 



function 

(state 



got o_st ate 
: yy . parse_st ate; 
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sym : nonterminal) return yy . parse_st ate ; 

function parse_action 

(state : yy . parse_st ate ; 

t : yy_tokens . token) return integer; 

pragma ini ine ( goto^state , parse_action) ; 



function goto_st ate ( state : yy . parse_state ; 

sym : nonterminal) return yy . parse_state is 

index : integer; 

begin 

index := goto_offset (state) ; 

while integer (goto_matrix (index ). nonterm) /= sym loop 
index := index + 1; 
end loop; 

return integer ( goto_matrix (index ) .newstate); 
end goto^state; 



function parse^act ion ( state : yy . parse_state ; 

t : yy_tokens . token) return integer is 



index 

tok_pos 

default 

begin 

tok_pos 

index 



integer; 

integer; 

constant integer := -1; 



yy_tokens .token'pos (t) ; 
shif t_reduce_of f set (state) ; 
while integer ( shif t_reduce_matrix ( index) .t) 
integer ( shif t_reduce_mat rix (index) . t ) 



/= tok^pos and then 
/= default 



loop 



index := index + 1; 
end loop; 

return integer ( shif t_reduce_matrix (index ) .act); 
end parse_action; 



error recovery stuff 

procedure handle_error is 
temp^action : integer; 

begin 



if yy . error_f lag = 3 then — no shift yet, clobber input, 
if yy. debug then 

put_line ( "Ayacc . YYParse : Error Recovery Clobbers " & 
yy_tokens .token ' image (yy . input_symbol ) ) ; 

end if; 

if yy . input_symbol = yy_tokens . end_of_input then — don't discard, 
if yy. debug then 

put_line ( "Ayacc . YYParse : Can't discard END_OF_INPUT, quiting . . . " ) ; 
end if; 

raise yy_t oken s . syntax__error ; 
end if; 
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yy . look_ahead := true; — get next token 
return; and try again. .. 

end if; 

if yy . error_f lag 0 then — brand new error 
yyerror ( "Syntax Error"); 
end if; 

yy . error_f lag := 3; 

-- find state on stack where error is a valid shift — 
if yy. debug then 

put line ( "Ayacc . YYParse : Looking for state with error as valid shift") 
end if; 

loop 

if yy. debug then 

put_line ( "Ayacc . YYParse : Examining State " & 

yy . parse_state ' image (yy . state_stack (yy . tos ) ) ) ; 
end if; 

temp_action := parse_act ion (yy . state_stack (yy . tos) , error); 

if temp_action >= yy . f irst_shif t_ent ry then 
yy.tos := yy.tos + 1; 

yy . state_stack (yy . tos ) := temp_action; 

exit ; 
end if; 

Decrement_St ack_Pointer : 
begin 

yy.tos := yy.tos - 1; 
exception 

when Const raint_Error => 
yy .tos : = 0; 

end Decrement^St ack^Pointer; 

if yy.tos = 0 then 
if yy. debug then 

put_line ( "Ayacc . YYParse : Error recovery popped entire stack, aborting.. ." 
end if; 

raise yy_tokens . syntax_error ; 
end if; 
end loop; 

if yy. debug then 

put_line ( "Ayacc . YYParse : Shifted error token in state " & 
yy . parse^state ' image (yy . state_stack (yy.tos) ) ) ; 

end if; 

end handle_error ; 

— print debugging information for a shift operation 

procedure shift_debug ( state_id : y y . parse_st ate ; lexeme: yy_tokens . token) is 
begin 
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& 



put_line ( "Ayacc . YYParse ; Shift "& yy . parse_state' image ( state_id) 
on input symbol "& 

yy_tokens . token' image ( lexeme) ); 

end; 



— print debugging information for a reduce operation 
procedure reduce_debug ( rule^id ; rule; state_id; yy . parse_state ) is 
begin 

put_line ( "Ayacc . YYParse : Reduce by rule "& rule ' image ( rule_id) 
&" goto state "& 

y y . parse_state' image (state_id) ) ; 

end; 

— make the parser believe that 3 valid shifts have occured . 

— used for error recovery, 
procedure yyerrok is 
begin 

yy . er ror_f lag := 0; 
end yyerrok; 

— called to clear input symbol that caused an error, 
procedure yyclearin is 

begin 

— yy . input_symbol ;= yylex; 
yy . look_ahead := true; 
end yyclearin; 



begin 

— initialize by pushing state 0 and getting the first input symbol 
yy . state_stack (yy . tos) := 0; 

loop 



yy. index ;= shif t_reduce_of f set (yy . state_stack (yy . tos) ) ; 
if integer ( shift_reduce_matrix (yy . index) .t) = yy. default then 
yy. action := integer (shift_reduce_matrix (yy . index) . act ) ; 

else 

if yy . look_ahead then 

yy . look_ahead := false; 
yy . input_symbol := yylex; 
end if; 
yy. action := 

par se_act ion ( yy . staters tack (yy . tos ) , yy . input_symbol) ; 
end if; 

if yy. action >= yy . f irst_shif t_entry then — SHIFT 
if yy. debug then 

shift_debug (yy . action, yy . input_symbol ) ; 
end if; 

— Enter new state 

yy.tos := yy.tos + 1; 

yy . state^stack (yy . tos) := yy. action; 
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yy . value_stack (yy . tos ) := yylval; 

if yy . error_f lag > 0 then -- indicate a valid shift 
yy .error_f lag := yy . error_f lag - 1; 
end if; 



— Advance lookahead 
yy . look_ahead := true; 

elsif yy. action = yy . error_code then — ERROR 

handle_error ; 

elsif yy. action = yy . accept_code then 
if yy. debug then 

put_line ( "Ay acc . YYParse : Accepting Grammar..."); 
end if; 
exit ; 

else — Reduce Action 

— Convert action into a rule 
yy.rule_id := -1 * yy. action; 

— Execute User Action 
— user_action (yy . rule_id) ; 
case yy.rule_id is 



when 1 => 

— #line 358 

The__Program := Empty_Psdl_Program; 

when 3 => 

— nine 366 

the_component_ptr := new PSDL_COMPONENT ; 

when 4 => 

— nine 369 

— /* the created object should always be constrained ■* / 

— since object is a record with discriminants. 

The_Component_Ptr := 
new Psdl_Component 

(Category => Component_Category (The_Component) , 
Granularity => Component_Granularity ( The_Component ) ) ; 

The_Component_Pt r . all := The_Component ; 

Bind_Program (Name ( The_Component ) , 

The_Component_Pt r , 

The_Program) ; 



when 8 => 

— nine 401 
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yyval := ( Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => The_I d_Token) / 

The_Operation_Map := Empty_Ope ration_Map ; 

when 9 => 

--nine 408 

— construct the psdl type using global variables 

— psdl component record fields that have default values 

— are passed as in out parameters, so that after 

— building tha component, they are initialized 

— back to their default values. 

Build_Psdl_Type ( 

yy . value_stack (yy . tos-2) . Psdl_Id_Value , 

The_Ada_NAme , 

The_Model, 

The_Data_Structure , 

The_Operat ion__Map, 

The_Type_Gen_Par , 

The_Keywords , 

The_De script ion, 

The_Axioms , 

Is_Atomic_Type, 

The_Component ) / 



when 11 => 

— Iline 440 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack , 
Empty_Type_Declaration) ; 

Type_Spec_Gen_Par := TRUE; 



when 12 => 

— nine 447 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack, 
The_Type_Gen_Par ) ; 

Type__Spec_Gen_Par ;= FALSE; 



when 14 => 

— nine 458 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack , 
Empty_Type_Declaration) ; 



when 15 => 
— nine 464 
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Type_Decl_St ack_Pkg . Pop ( The__Type_Decl_St ack, 
The Model) ; 



when 17 => 

— nine 476 

The_Op_Ptr := new Operator; 

when 18 => 

— nine 479 



yyval := { Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => The_Id_Token) ; 

— create a new operator (composite ) to put in ops map 

— make it composite because we don' t know what 

— the granularity is at this point. 

The_Op_Ptr := new Operator (Category => Psdl_Operator, 

Granularity => Composite); 



when 19 => 
— nine 491 



Build_Psdl_Operator ( 
yy . value_stack (yy . tos-1 ) . Psdl_Id_Value , 
The_Ada_Name , 

The_Gen_Par , 

The_Key words , 

The_De script ion, 

The_Axioms , 

The_Input , 

The_Output , 

The_St ate , 

The_Initial_Expres sion, 
The_Except ions , 

The_Specif ied_Met , 
The_Graph, 

The_St reams, 

The_Timers , 

The_Trigger, 

The_Exec_Guard, 

The_Out_Guard, 

The__Excep_T rigger, 
The_Timer_Op, 

The_Per, 

The_Fw, 

The_Mcp, 

The_Mrt, 

The_Impl_Desc, 

Is_Atomic => False, 

The_Opr => The_Ope rator ) ; 
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The_Op_Ptr . all := The_Operat or ; 
Bind_Operat ion ( 

yy . value_stack (yy . tos"-! ) . P sdl_Id_Value , 
The_Op_Ptr, 

The_Operat ion_Map) ; 



when 21 => 
— nine 533 



yyval := ( Token_Category => Psdl_Id_String, 

P sdl_Id_Value => The_Id_Token) ; 



when 22 => 
— #line 539 



— construct the psdl operator 

— using the global variables 
Build_Psdl_Operator ( 

yy . value_stack (yy . tos-2) .Psdl_Id_Value, 

The_Ada_Name , 

The_Gen_Par, 

The_Keywords , 

The_De script ion, 

The_Axioms , 

The_Input , 

The_Output , 

The_State , 

The_Init ial_Expression , 

The_Except ions , 

The_Specif ied_Met , 

The_Graph, 

The_St reams, 

The_Timers, 

The_Trigger, 

The_Exec_Guard, 

The_Out_Guard, 

The_Excep_T rigger, 

The_Timer_Op, 

The_Per, 

The_Fw, 

The_Mcp, 

The_Mrt , 

The_Impl_Desc, 

Is_Atomic_Operator, 

The_Component ) ; 



when 26 => 

— nine 589 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack, 
Empty_Type_Declaration) ; 
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when 27 => 
— #line 595 



Type_Decl_St ack^Pkg . Pop ( The_Type_Decl_St ack, 
The_Gen_Par) ; 



when 28 => 

— #line 602 

Type_Decl_Stack_Pkg . Push ( The_Type_Decl_Stack , 
Empty_Type_Declarat ion) ; 



when 29 => 

— #line 609 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_Stack, 
The_Input) ; 



when 30 => 

— #line 616 

Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack , 
Empty_Type_Declarat ion) ; 



when 31 => 

— Iline 622 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_Stack, 
The_Output ) ; 



when 32 => 

— #line 629 

Type_Decl_St ack_Pkg . Push ( The_Type_Decl_St ack , 
Empty_Type_Declarat ion) ; 

Id_Seq_Pkg . Empty (The_Id_Seq) ; 

— empty id seq, to use with init map 



when 33 => 
— #line 637 



Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack , 
The_State) ; 

The_Init_Map_Id_Seq := The_Id_Seq; 

— hold the id's for init map. 
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when 34 => 
— nine 647 



Init_Exp_Seq_Stack_Pkg . Push (The_Init_Exp_Seq_Stack, 

Empty_Exp_Seq) ; 

The_Expression_St ring := Expression (A_St rings . Empty ) ; 



when 35 => 

— nine 655 

Init_Exp_Seq_Stack_Pkg .Pop (The_Init_Exp_Seq_Stack, 

The_Init_Expr_Seq) ; 
Bind_Initial_State (The^State, 

The_Init_Expr_Seq, 
The_Initial_Expression) ; 



when 36 => 

— nine 665 

Id_Set_Pkg . Empty (The_Id_Set) ; 



when 37 => 

— nine 670 

Id_Set_Pkg . Assign ( The_Except ions , The_Id_Set) ; 



when 38 = > 

— nine 678 

The_Specif ied_Met 

yy . value_stack (yy . tos) . Integer_Value ; 



when 41 => 

— nine 695 

The_Id_Set := Empt y_Id_Set ; 



when 42 => 

— nine 700 

The_Expression_String ;= The_Expression_String & " : 
Id_Set_Stack_Pkg .Push (The_Id_Set_Stack, The_Id_Set) ; 



when 43 => 

— nine 706 



Type_Decl_Stack_Pkg . Pop (The_Type_Decl_Stack, 
Temp_Type_Decl) ; 
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— /* Bind each id in id the id set to the type name * / 

* in the internal stack ($5), return temp_type_decl */ 
Bind_Type_Declarat ion ( 

Id_Set_Stack_Pkg . Top (The_Id_Set_Stack ) , 

yy . value_stack (y y . tos ) . Type_Name_Value , 

Temp_Type_Decl ) ; 

Type_Decl_Stack_Pkg . Push (The_Type_Decl_Stack , 
Temp__Type_Decl ) ; 

pop the stack after bind */ 
Id_Set_Stack_Pkg . Pop (The_Id_Set_Stack) ; 



when 44 => 
— Iline 729 



yyval := ( Token_Category => Psdl_Id_String, 

Psdl_Id_Value => The_Id_Token) ; 

The_Expres sion_St ring := The_Expre ss ion_St ring & " 
& Expression ( The_Id_Token ) ; 



when 45 => 

— nine 738 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack, 
Empty_Type_Declaration) ; 

The_Expres sion_String := The_Expression_St ring & " ["; 



when 46 => 
— Iline 746 



The_Type_Name := New Type_Name_Record ; 

The_Type_Name . Name := 

yy . value_stack (yy . tos-3) . Psdl_Id_Value ; 

The_Type_Name . Gen_Par 

:= Type_Decl_Stack_Pkg . Top (The_Type_Decl_Stack) ; 

yyval := (Token_Category => Type_Name_St ring, 
Type_Name_Value => The_Type_Name ) ; 

Type_Decl_St ack_Pkg . Pop ( The_Type_Decl_St ack) ; 



when 47 => 

— Iline 758 

The_Expression_String := The_Expression_String & "] 
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when 48 => 
— #line 761 



— this an awkward way of working around the 

— problem we get when we have two identifiers 

— one after another 

if Type_Spec_Gen_Par and 

not Id_Set_Pkg . Member ( The_Prev_Id_Token, 

The_Id_Set ) 

The_Type_Name ;= 

New Type_Name_Record ' ( The_Prev_Id_Token, 
Empty_Type_Declaration) ; 

The_Expression_String := The_Expres sion_String & " " 

& Expression (The_Prev_Id_Token) ; 
else 

The_Type_Name ;= 

New Type_Name_Record' ( The_Id_Token , 

Empty_Type_Declaration) ; 

The_Expression_String := The_Expression_String & " " 

& Expression (The_Id_Token) ; 
end if; 



yyval ;= ( Token^^Category => Type_Name_String, 

Type_Name_Value => The_Type_Name ) / 



when 49 => 

— nine 793 

The_Expre ssion_String := The_^Expression_String & ", " ; 

when 50 => 

— #line 796 

Id_Set_Pkg . Add (The_Id_Token, The_Id_Set) / 

The_String := The_String & " & The_Id_Token; 

Id_Seq_Pkg . Add (The_Id_Token, The_Id_Seq) ; 
The_^Expression_String ;= The_Expression_St ring & " " 
& Expre ssion ( The_Id_Token) ; 



when 51 => 

~#line 805 

Id_Set_Pkg . Add (The_Id_Token, The_Id_Set) ; 
The_String := The_Id_Token ; 

Id_Seq_Pkg . Add (The_Id_Token, The_Id_Seq) ; 
The_Expression_String ;= The_Expression_String & 
& Expression (The_Id_Token) ; 



when 55 => 

— #line 828 

Id_Set_Pkg . Empty ( The_Id__Set ) ; 



then 
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when 56 => 
— fline 833 



Id_Set_Pkg .Assign ( The_Keywords , The_id_Set) 



when 57 = > 

— #line 837 

The_Keywords := Empty_Id_Set ; 

when 58 => 

— Iline 843 

The_Description := The_Text_Token; 
The_Impl_Desc := The_Text_Token; 



when 60 => 

— nine 853 

The_Axioms:= The_Text_Token; 



when 62 = > 

— nine 862 

Is_Atomic_Type := True; 

The_Ada_Name := Ada_Id f The_Id_Token ) ; 



when 64 => 

— #line 871 

Is_Atomic_Type := False; 
The_Data_Structure := 
yy . value_stack (yy . tos) . Type_Name_Value ; 



when 66 => 

— #line 883 

The_Op_Ptr := New Operator; 

when 67 => 

— nine 886 



yyval 



(Token_Category => Psdl_Id_String, 
Psdl_Id_Value => The_Id_Token) ; 



when 68 => 
— nine 891 
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— add implementation part to the operator in the operation map 
Add_Op_Impl_To_Op_Map ( 
yy . value_stack (yy . tos-1 ) . Psdl_Id_Value , 

The_Ada_Name , 

Is_Atomic_Operator , 

The_Operation_Map, 

The_Graph, 

The_St reams, 

The_Timers , 

The_Trigger, 

The_Exec_Guard, 

The_Out_Guard, 

The_Excep_Trigger , 

The_Timer_Op , 

The_Per, 

The_Fw, 

The_Mcp, 

The_Mrt, 

The_Impl_Desc ) ; 



when 70 => 

— #line 917 

Is_Atomic_Operat or := True; 
The_Ada_Name := Ada_Id (The_Id_Token) ; 



when 72 => 

— Iline 925 

Is_Atomic_Operat or := False; 

when 74 = > 

— Iline 934 

The_Impl_Desc := Empty_Text; 

when 76 => 

— Iline 942 

The_Graph := Empty_Psdl_Graph / 

when 78 => 

— Iline 950 

The^Graph := Psdl_Graph_Pkg . Add_Vertex ( 
yy . value_stack (yy .tos-1) . P sdl_Id_Value , 
The_Graph, 

yy . value_stack (yy . tos) . Integer_Value ) ; 



when 80 => 

— Iline 961 

The_Edge_Name := The_Id_Token / 
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when 81 => 
->-#line 964 



The_Graph := Psdl_Graph_Pkg . AddEdge ( 
yy . value_stack (yy.tos-2) . Psdl_Id_Value , 

yy . value_stack (yy.tos) . Psdl_Id_Value , 

The_Edge_Name , 
The_Graph, 

yy . value_stack (yy . tos-3) . Integer_Value ) ; 



when 83 = > 
— nine 978 



yy val 



(Token_Category => Psdl_Id_String, 
Psdl Id Value => The Id Token) ; 



when 84 => 
— #line 984 



yyval := ( Token_Cat egory => Psdl_Id_String, 

Psdl_Id_Value => 

yy . value_stack (yy.tos-1) . Psdl_Id_Value 
& 



yy . value_stack (yy . tos) . P sdl_Id_Value ); 



when 85 => 

— #line 993 

The_String := P sdl_Id (A_St rings . Empty ) / 

when 86 => 

— nine 996 



yyval := ( Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => "(" & The_String) ; 
The_String := Psdl_Id (A_St rings , Empty ) 



when 87 => 

— nine 1004 



yyval := ( Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value = > 

yy . val ue_s tack (yy . tos-3) , P sdl_Id_Val ue 

& "I" & The_String & ); 
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when 88 => 

— Iline 1010 

yyval := ( Token^Cat egory => Psdl_Id_String, 

Psdl_Id_Value => Psdl_Id (A_St rings . Empty) ) 



when 91 => 

— Iline 1026 



yyval := ( Token_Category => Integer_Literal , 

Integer_Value => 

yy . valuers tack (yy . tos) . Int eger_Value ) ; 



when 92 => 

— Iline 1031 

yyval := ( Token_Cat egory => Integer_Literal , 

Integer_Value => 0) ; 



when 93 => 

— Iline 1038 

Type_Decl_St ack_Pkg . Push (The_Type_Decl_Stack , 
Empty_Type_Declarat ion) ; 



when 94 => 

— Iline 1044 

Type_Decl_Stack_Pkg . Pop ( The_Type_Decl_St ack, 
The_St reams) ; 



when 96 => 

— Iline 1059 

Id_Set_Pkg .Empty (The_Id_Set) ; 



when 97 => 

— Iline 1064 

Id_Set_Pkg . Assign ( The_Timers , The_Id_Set ) ; 



when 98 => 

— Iline 1068 

Id_Set_Pkg .Assign (The_Timers , Empty_Id_Set ) ; 
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when 99 = > 

— #line 1077 



The^Operat or^Name := 
The_Trigger := 
The_Per := 
The_Fw := 
The_Mcp := 
The_Mrt := 
The_Exec_Guard := 
The_Out_Guard := 
The_Excep_Trigger := 
The_Timer_Op := 



when 101 => 

— Iline 1094 

The_Operat or_Name := 



when 103 => 

— #line 1102 

The_Operat or^Name := 



The_I d_Token; 

Empt y_T ri gger_Map ; 

Empty_Timing_Map; 

Empty_Timing_Map; 

Empty_Timing_Map; 

Empty_Timing_Map; 

Empty_Exec_Guard_Map; 

Empty_Out_Guard_Map; 

Empty_Excep_Trigger_Map; 

Empt y_T imer_Op_Map ; 



The_I d_Token; 



The_Id_Token; 



when 105 => 

— #line 1113 

The_Id_Set ;= Empt y_Id_Set ; 

The_Expression_String := Expression (A_St rings . Empt y) 
The_Output_Id . Op := The_Operator_Name ; 



when 106 => 

— #line 1120 

The_Expression_St ring := Expression (A_St rings . Empty ) 



when 107 => 
— #line 1125 



— Begin Expansion Of Foreach Loop Macro, 
declare 

procedure Loop_Body(Id : Psdl^Id) is 
begin 

The_Output_Id . St ream := Id; 
Bind_Out_Guard ( The_Output_Id, 
The_Expres sion_St ring, 

The Out Guard ) ; 
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end Loop_Body; 
procedure Execute_Loop is 

new Id_Set_Pkg . Generic_Scan (Loop_Body ) ; 

begin 

Execute_Loop (The_Id_Set) / 
end; 



when 108 => 
— #line 1146 



yyval ( Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => The_I d_Token) / 

The_Expression_St ring := Expre ssion (A_St rings . Empty ) ; 



when 109 => 

— #line 1153 

The_Excep_Id . Op := The_Operat or_Name; 

The_Excep_Id . Excep := 
yy . value_stack (yy . tos-2 ) . Psdl_Id_Value ; 

Bind_Excep_Trigger ( The_Excep_Id, 
The_Expression_String, 
The_Excep_Trigger) ; 



when 110 => 
— #line 1162 



yyval := (Token_Category => Psdl_Id_St ring, 

Psdl_Id_Value => The_Id_Token) ; 
The_Expression_String ;= Expression (A_St rings . Empty ) ; 



when 111 => 

— #line 1169 

The_Timer_Op_Record . Op_Id := 

yy . value_stack (yy . tos-4 ) . Timer_Op_Id_Value; 

The_Timer_Op_Record . Timer_Id := 
yy . value_stack (yy . tos-2) . Psdl_Id_Value ; 

The_Timer_Op_Record . Guard := The_Expression_String; 

Timer_Op_Set_Pkg .Add (The_Timer_Op_Record, 
The_Timer_Op_Set ) ; 

Bind_Timer_Op ( The_Operator_Name , 

The_Timer_Op_Set , 

The_Timer_Op) ; 



when 113 => 
— #line 1186 



370 



The_Expression_String := Expression (A_Strings . Empty > 



when 114 => 

— #line 1191 

Bind_Exec_Guard (The_Operat or_Name, 
The_Expression_String , 
The_Exec_Guard) ; 



when 116 => 

— #line 1202 

The_Id_Set := Empty_Id_Set ; 



when 117 => 

— Iline 1207 

The_Trigger_Record . Tt := By_All; 

The_Trigger_Record . Streams := The_Id_Set; 

Bind_Trigger { The_Operator_Name , 
The_Trigger_Record, 

The_Trigger) ; 



when 118 => 

— nine 1217 

The_Id_Set := Empty_Id_Set ; 



when 119 => 

— nine 1222 

The_Trigger_Record . Tt := By_Some/ 

The_Trigger_Record . Streams := The_Id_Set; 
Bind_Trigger { The_Operator_Name , 
The_Trigger_Record, 

The_Trigger) ; 

when 120 => 

— nine 1232 

— we don't care what is in the id set 

The_Trigger_Record . Tt := None; 

The_Trigger_Record . Streams := The_Id_Set; 
Bind_Trigger { The_Operator_Name , 

The_Trigger_Record, 

The_Trigger) ; 
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when 121 => 
— #line 1245 



Bind_Timing ( The_Operator_Name , 

yy . value_stack (yy . tos) . I ntege revalue , 
The_Per) / 



when 123 => 

— Iline 1257 

Bind_Timing ( The_Operat or_Name , 

yy . value_stack (yy . tos-1) . Integer_Value , 
The_Fw) ; 



when 125 => 

— Iline 1268 

Bind_Timing (The_Operator_Name, 

yy . value_stack (yy , tos-1 ) . I nteger_Value , 
The_Mcp) ; 



when 127 => 

— Iline 1279 

Bind_Timing (The_Operator_Name, 

yy . valuers tack (yy . tos) . Integer_Value , 
The_Mrt) ; 



when 130 => 
— Iline 1295 



yyval := ( Token_Category => Timer_Op_Id_St ring, 

Timer_Op_Id_Value => Reset) ; 



when 131 => 
— Iline 1302 



yyval := ( Token_Category => Timer_Op_Id_St ring, 

Timer_Op_Id_Value => Start) ; 



when 132 => 
— Iline 1309 
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yyval := ( Token_Category => Timer_Op_Id_St ring, 

Timer_Op_Id_Value => Stop) ; 



when 135 => 

— #line 1335 

The_Expression_String := Expre ssion (A__St rings .Empty); 



when 136 => 
— tline 1340 



Init_Exp_Seq_Stack_Pkg .Pop ( The_Init_Exp_Seq_Stack 

Temp_Init_Expr_Seq) ; 



Exp_Seq_Pkg . Add ( 

yy . valuers tack (yy . tos) . Expression_Value, 

Temp_Init_Expr_Seq) ; 

Init_Exp_Seq_Stack_Pkg . Push ( The_Init_Exp_Seq_Stack 

Temp^I nit_Expr_Seq) ; 



when 137 => 

— Iline 1350 

The_Expression_String := Expression (A_St rings . Empty ) ; 



when 138 => 
— Iline 1355 



Init_Exp_Seq_Stack_Pkg .Pop ( The_Init_Exp_Seq_Stack 

Temp_Init_Expr_Seq) ; 

Exp_Seq_Pkg . Add ( 

yy . value_stack (yy . tos) . Expre ssion_Value , 

Temp_Init_Expr_Seq) ; 

Init_Exp_Seq_Stack_Pkg . Push ( The_Init_Exp_Seq_Sta ck 

Temp_I nit_Expr_Seq) ; 



when 139 => 
— Iline 1381 



yyval := ( Token^Category => Expression_String, 

Expression_Value => To_A( "True")); 



when 140 => 
— Iline 1388 



yyval := ( Token_Category => Expression_String, 
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Expression_Value => To_A{ "False")); 



when 141 => 
— #line 1395 



yyval := ( Token_Category => Expres sion_String, 

Expression_Value => Expression (The_Integer_Token) ) ; 



when 142 => 
— #line 1401 



yyval := (Token_Category => Expression_String, 
Expression_Value => The_Real_Token) ; 



when 143 => 
— #line 1407 



yyval := ( Token_Category => Expres sion_String, 

Expression_Value => The_Str ing_Token) ; 



when 144 => 
— #line 1413 



yyval := ( Token_Category => Expression_String, 

Expression_Value => Expression (The_Id_Token)); 



when 145 => 

— Iline 1423 

The_Expression_String := The_Expression_St ring & & 

Expression ( The_Id_Token ) ; 

yyval := ( Token_Category => Expression_String, 

Expression_Value => The_Expressioii_St ring) ; 

when 146 => 

— Iline 1431 



yyval 



(Token_Category => Expression_String, 

Expre ssion_Value => The_Expression_St ring & 

& Expression (The_Id_Token ) ) ; 



when 147 => 
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— nine 1438 



Init_Exp_Seq_Stack_Pkg .Push ( The_Init_Exp_Seq_Stack , 

Empty_Exp_Seq) ; 



when 148 => 

— #line 1444 

— /* we remove expression resulted by the */ 

— previous rule, since expression will */ 

— /* be concatination of Type_name.ID and */ 

value of previous production * / 

Init_Exp_Seq_Stack_Pkg . Pop ( The_I ni t_Exp_Seq_St ack , 

Temp_Init_Expr_Seq) ; 

The_Expressi on_String := Expression (A_St rings . Empty ) ; 

for i in 1 . . Exp_Seq_Pkg . Length (Temp_Init_Expr_Seq) loop 

if i > 1 then 

The_Expression_String := The_Expression_String & " 

end if; 

The_Expression_String := 

The_Expression_String & 

Exp_Seq_Pkg . Fetch (Temp_Init_Expr_Seq, i 

end loop; 

Exp_Seq_Pkg . Recycle ( Temp_Init_Expr_Seq) ; -- throw it away 



yyval := ( Token_Category => Expression_St ring, 

Expression_Value => 

yy . value_stack (yy . tos-4 ) . Expression^Value & "(" & 

The_Expression_St ring & 



when 149 => 
— nine 1471 



yyval ;= ( Token_Catego ry => Expression_String, 

Expression_Value => To_A("(") & 

yy . value_stack (yy . tos-1 ) . Expression_Value & 

To_A(") ") ) ; 



when 150 => 
— nine 1480 



yyval := ( Token_Category => Expression_String, 

Expression^Value => 

yy . value_stack (yy . tos-1 ) . Expression_Value & 
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yy . value_stack (yy . tos) . Expre ssion_Value) ; 



when 151 => 
— #line 1487 



yyval := ( Token_Category => Expression_String, 

Expre ssion_Value => 

yy . value_stack (yy . tos-1 ) . Expression_Value & 
yy . value_stack (yy . tos) . Expression_Value) ; 



when 152 => 
— Iline 1497 



yyval := (Token_Category => Expression_String, 
Expression_Value => 

yy . value_stack (yy . tos-2 ) . Expression_Value & 
yy .value_stack (yy . tos-1) . Expression_Value & 
yy . value_stack (yy . tos) . Expression_Value) ; 



when 153 => 
— #line 1507 



yyval := ( Token_Cate gory => Expression_String, 

Expre ssion_Value => To_A(”-") & 

yy . value_stack (yy.tos) . Expression_Value) ; 

when 154 => 

— #line 1513 



yyval := (Token_Category => Expression_String, 
Expression_Value => To_A("+") & 

yy . value_stack (yy.tos) . Expre ssion_Value) ; 



when 155 => 
— nine 1522 



yyval := ( Token_Category => Expression__String, 

Expression_Value => 

yy . value_stack (yy . tos-2 ) . Expression_Value & 
yy . value_stack (yy . tos-1 ) . Expression_Value & 
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yy . value_stack (yy.tos) . Expression_Value ) ; 



when 156 => 
— Iline 1533 



yyval := ( Token_Category => Expres sion_St ring, 
Expre ssion_Value => 

yy . value_stack (yy . tos-2 ) . Expression_Value & 
yy . value_stack (yy . tos-1 ) . Expression_Value ^ 
yy . valuers tack (yy . tos) . Express ion_Value ) ; 



when 157 => 
— #line 1544 



yyval := ( Token_Category => Expression^String, 

Expre ssion_Value => 

yy . value_stack (yy . tos-2) . Expression_Value & 

To_A(" EXP ") & 

yy . value_stack (yy.tos) . Express ion_Value) ; 



when 158 => 

— #line 1555 

--Exp_Seq_Pkg . Add ( The_Expression_St ring, The_Exp_Seq) 

yyval := ( Token_Category => Expression_Str ing, 

Expression_Value => To_A(" NOT ") & 

yy . value_stack (yy.tos) . Expre ssion_Value) ; 



when 159 => 
— Iline 1565 



yyval 



( Token_Category => Expression^String, 
Expression_Value => To_A(" NOT ") & 



yy . value_stack (yy.tos) . Expre ssion_Value ) ; 



when 160 => 
— Iline 1575 



yyval 



( Token_Category => Expression_String, 

Expression_Value => To_A(" AND ") ) ; 
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when 161 => 
— Iline 1581 



yyval := ( Token_Category => Expression_String, 

Expression_Value => To_A(" OR ") ) ; 

when 162 => 

— Iline 1587 



yyval := 


(Token Category => Expression String, 

Expression_Value => To_A(" XOR ") ) ; 



when 163 => 
— Iline 1597 



yyval := 


(Token Category => Expression String, 

Expression_Value => To_A(" < ") ) ; 



when 164 => 
— Iline 1603 



yyval := 


(Token Category => Expression String, 

Expression Value => To A(" > ") ) ; 



when 165 => 
— Iline 1609 



yyval := 


(Token Category => Expression String, 

Expression_Value => To A(" = ") ) ; 



when 166 => 
— Iline 1615 



yyval := 


( Token_Category => Expression String, 

Expression Value => To A(" >= ")); 



when 167 => 

— Iline 1622 

yyval := ( Token_Category => Expression_String, 
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Expression_Value => To_A(" <= ")); 



when 168 => 
— #line 1629 



yyval := (Token_Category => Expression_String 
Expre ssion_Value => To_A(" /= ") ) ; 



when 169 => 
— #line 1640 



yyval := ( Token_Category => Expression^String 

Expression^Value => To_A(" + ") ) ; 



when 170 => 
— #line 1646 



yyval := ( Token_Category => Expres sion_St ring 

Expression_Value => To_A(" - ") ) ; 



when 171 => 
— Iline 1652 



yyval := ( Token^Category => Expression_St ring 

Expression_Value => To_A(" & ") ) ; 



when 172 => 
— tline 1661 



yyval := ( Token_Category => Expression_St ring 

Expression_Value => To_A(" + ”) ) ; 



when 173 => 
— tline 1667 



yyval := ( Token_Category => Expression^String 

Expression_Value => To_A(" - ") ) ; 



when 174 => 
— tline 1673 
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yyval := ( Token_Category => Expres sion_String, 

Expression_Value => To_A ( " MOD ") ) ; 



when 175 => 
— lime 1679 



yyval := ( Token_Category 

Expre ssion_Value 



=> Expression_String, 
=> To_A(" REM ")); 



when 176 => 

— nine 1689 

yyval := ( Token_Category => Integer_Literal , 

I nteger_Value => ( 

yy . value_stack (yy . tos-1 ) . Integer_Value + 999)/1000); 
The_Time_String := 

To_A (Integer' Image ( 

yy . value_stack (yy . tos-I ) . Integer_Value ) & " microsec"); 



when 111 => 
— Iline 1697 



yyval := ( Token_Category => Integer_Literal, 

Integer^Value => 

yy . value_stack (yy . tos-1 ) . Integer_Value ) ; 
The_Time_String := 

To_A (Integer' Image ( 

yy . value_stack (yy . tos-1 ) . Integer_Value ) & " ms")/ 



when 178 => 
— Iline 1705 



yyval := ( Token_Category => Integer_Literal, 

Integer_Value => 

yy . value_stack (yy . tos-1 ) . I nteger_Value * 1000); 
The__Time_String : = 

To_A (Integer' Image ( 

yy . value__stack (yy . tos-1 ) . Integer_Value ) & " sec"); 



when 179 => 
— Iline 1714 



yyval := ( Token_Category => Integer_Literal , 

I nteger_Value => 

yy . value_stack (yy . tos-1 ) . I nteger_Value * 60000); 
The_Time_String := 
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To_A (Integer' Image ( 

yy . value_stack (yy . tos-1 ) . I nteger_Val ue ) & " min"); 



when 180 => 
— nine 1723 



yyval := ( Token_Category => Integer_Literal , 

Integer_Value => 

yy . value_stack (yy . tos-1 ) . I nteger_Value * 3600000); 
The_Time_St ring := 

To_A (Integer' Image ( 

yy . value_stack (yy . tos-1 ) . I nteger_Value) & " hrs"); 



when 181 => 
— nine 1734 



yyval := ( Token_Category 

Integer_Value 



= > Integer_Literal , 

=> Convert_To_Digit (The_Integer_Token . S ) ) ; 



when 182 => 

— nine 1746 

The_Time_String := Expression (A_St rings . Empty) ; 



when 184 => 

— nine 1751 

The_Time_String := Expression (A_St rings .Empty); 



when 186 => 

— nine 1771 

The_Expression_String := The_Expression_String & 



when 187 => 

— nine 1776 

The_Expres sion_String := The_Expression_St ring & 



when 188 => 

— tline 1782 

The_Expression_String := The_Expression_St ring & " " & 
Expression ( The_Integer_Token) ; 



TRUE "; 



FALSE " 
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when 189 => 
— #line 1788 



The_Expression_String := The_Expression_St ring & " " & 
The_Time_St ring ; 



when 190 => 
— #line 1794 



The_Expression_String := The_Expression_String & ” " & 
The_Real_Token; 



when 191 => 
— Iline 1800 



The_Expression_String := The_Expression_St ring & " " & 
The_String_Token; 



when 192 => 

— Iline 1806 

The_Expression_String := The_Expression_String & " " & 
Expression ( The_Id_Token) / 



when 193 => 

— Iline 1814 

The_Expression_String := The_Expression_String & ” . " & 
Expression (The_Id_Token) ; 



when 194 => 

— Iline 1820 

The_Expression_String := The_Expression_St ring & & 

Expression (The_Id_Token) ; 



when 195 => 

— lime 1826 

The_Expression_St ring := The_Expression_String & " ("; 

when 196 => 

— Iline 1829 



The_Expression_String := The_Expression_String & ") 
Exp_Seq_Pkg . Add ( The_Expression_St ring, The_Exp_Seq) ; 



when 197 => 
— Iline 1836 
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The_Expression_String := The_Expression_String & " ("; 

when 198 => 

— #line 1839 

The_Expression_String := The_Expression_String & ") 

when 199 => 

— #line 1842 



yy 



The_Expression_St ring := 
The_Expression_String & 
value_stack (yy .tos) . Expre ssion^Value; 



when 201 => 
— #line 1851 



yy 



The_Expression_St ring := 
The_Expression_String & 
value_stack (yy.tos) . Expression__Value; 



when 203 => 

— #line 1859 

The_Expression_String := The_Expression_String & • 

when 205 => 

— Iline 1864 

The_Expression_St ring := The_Expr ession_String & ; 

when 207 -> 

— lime 1869 



The_Expression_String := 
The_Expression_String & 
yy . value_stack (yy.tos) . Expre ssion_Value ; 

when 209 => 

— Iline 1877 

The_Expression_String ;= 
The_Expression_String & 
yy , value_stack (yy.tos) . Expre ssion_Value; 

when 211 => 

— Iline 1885 

The_Expression_String := 
The_Expression_String & " EXP 

when 213 => 

— Iline 1892 

The_Expression_St ring := To_A ( " NOT "); 
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when 215 => 

— #line 1897 

The^Expre ssion_St ring := To__A(" ABS "); 

when others => null; 
end case; 

— Pop RHS states and goto next state 

yy.tos := yy.tos - rule_length ( yy . rule_id) + 1; 

yy . state__stack (yy . tos) := goto_state (yy . state^stack (yy . t os-1 ) , 

get_lhs_rule (yy ,rule_id) ) ; 

yy . val ue^stack (yy . tos ) := yyval; 

if yy. debug then 

reduce^debug (yy . rule^id, 

goto_state (yy . state_stack (yy . tos - 1), 
get_lhs_rule (yy . rule^id) ) ) ; 

end if; 

end if; 
end loop; 

end yyparse; 

end Parser; 
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APPENDIX V. PACKAGE PSDL.GOTO 



package Psdl__Goto is 

type Small_Integer is range -32_000 . . 32_000; 

type Goto_Entry is record 

Nonterm ; Small_Integer ; 

Newstate : Small_Integer ; 
end record; 

— pragma suppress ( index_check) / 

subtype Row is Integer range -1 .. Integer ' Last ; 

type Got o_Parse_Table is array (Row range <>) of Goto_Entry; 

Goto_Matrix : constant Got o_Parse_Table := 

((-1,-1) — Dummy Entry. 

— State 0 

, (-3, 1) , (-2, 2) 

— State 1 
, (-4, 3) 

— State 2 

— State 3 
, (-5, 5) 

— State 4 

— State 5 

, (-8, 7) , (-7, 6) , (-6, 10) 

— State 6 

— State 7 

— State 8 

— State 9 

— State 10 

— State 11 

, (-9, 13) 

— State 12 

, (-22, 14) 

— State 13 
, (-10, 16) 

— State 14 
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, (-21, 18) 

— State 15 
, (-12, 20) 

— State 16 
, (-11, 22) 

— State 17 
, (-24, 23) 

State 18 
, (-23, 25) 

— State 19 
, (-16, 26) 

— State 20 

, (-18, 27) , (-13, 28) 

— State 21 
, (-40, 31) 

— State 22 

— State 23 
, (-45, 32) 

, (-25, 41) , (-15, 40) 

— State 24 

, (-62, 43) , (-57, 42) 

, (-55, 45) 

— State 25 

— State 26 

, (-38, 48) , (-37, 47) , (-17, 46) 

— State 27 

, (-38, 48) , (-37, 47) , (-17, 49) 

— State 28 
, (-14, 50) 

— State 29 
, (-41, 51) 

— State 30 

— State 31 
, (-50, 53) 

— State 32 
, (-46, 55) 

— State 33 
, (-27, 56) 

— State 34 
, (-28, 57) 

— State 35 
, (-29, 58) 

— State 36 
, (-30, 59) 

— State 37 
, (-34, 60) 



38 (. 



state 38 



— 


State 


39 


; (■ 


-48, 62) 




— 


State 


40 


— 


State 


41 


, (■ 


-26, 65) 




— 


State 


42 


/ (■ 


-58, 67) 




— 


State 


43 


— 


State 


44 


— 


State 


45 


, ( 


-56, 70) 




— 


State 


46 


— 


State 


47 





State 


48 


, ( 


-35, 72) 




— 


State 


49 





State 


50 



, (-45, 32) , (-19, 75) , (-15, 74) 



State 


51 


State 


52 


■49, 77) 




State 


53 


■51, 78) 




State 


54 


State 


55 


-47, 81) 




State 


56 



, (-38, 48) 

, (-37, 47) , (-17, 82) 

— State 57 

, (-38, 48) , (-37, 47) 

, (-17, 83) 

-- State 58 

, (-38, 48) , (-37, 47) , (-17, 84) 

— State 59 

, (-38, 48) , (-37, 47) , (-17, 85) 

— State 60 
, (-35, 86) 

— State 61 

— State 62 
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(-35, 88) 




- State 


63 


- State 


64 


(-35, 89) 




- State 


65 


- State 


66 


- State 


67 


(-59, 92) 




- State 


68 


(-63, 93) 




- State 


69 


(-54, 94) 




- State 


70 


- State 


71 


(-38, 48) 


, (- 


- State 


72 


- State 


73 


- State 


74 


- State 


75 


- State 


76 


(-42, 101) 


-- State 


77 


-- State 


78 


(-52, 104) 


-- State 


79 


-- State 


80 


-- State 


81 


-- State 


82 


-- State 


83 


-- State 


84 


-- State 


85 


(-31, 106) 


— State 


86 



— state 87 

, (-107, 107) , (-36, 109) 

— State 88 
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state 89 



— State 90 

, (-73, 110) 

— State 91 
, (-74, 111) 

— State 92 
, (-60, 113) 

— State 93 

, (-64, 114) 

— State 94 

— State 95 

— State 96 

— State 97 

, (-39, 117) 

-- State 98 
, (-44, 118) 

— State 99 

— State 100 

— State 101 

, (-38, 48) , (-37, 47) 

, (-17, 120) 



— 


state 


102 


— 


State 


103 


— 


State 


104 


— 


State 


105 


— 


State 


106 


— 


State 


107 


— 


State 


108 


— 


State 


109 


— 


State 


110 


/ ( 


00 

CO 

ro 

1 


, (-: 


— 


State 


111 


, ( 


-35, 129) 


— 


State 


112 


— 


State 


113 


, ( 


-61, 131) 


— 


State 


114 
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— state 


115 


, (-65, 134) 


— State 


116 


— State 


117 


, (-40, 135) 


— State 


118 


— State 


119 


, (-20, 137) 


-- State 


120 


, (-43, 138) 


— State 


121 


— State 


122 


, (-32, 140) 


— State 


123 


— State 


124 


— State 


125 


— State 


126 


— State 


127 


— State 


128 


— State 


129 


— State 


130 


, (-75, 141) 


— State 


131 


, (-46, 142) 


— State 


132 


— State 


133 


, (-68, 144) 


— State 


134 


, (-66, 146) 


— State 


135 


— State 


136 


— State 


137 


, (-21, 14 


7) 


— State 


138 


— State 


139 


, (-53, 14 


9) 


— State 


140 
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, (-99, 151) , (-33, 

— State 141 

, (-76, 152) 

— State 142 

— State 143 

, (-67, 154) 

— State 144 

, (-70, 155) , (-69, 

— State 145 

, (-107, 107) 

, (-36, 157) 



— 


state 


146 


— 


State 


147 


-- 


State 


148 


— 


State 


149 


/ (- 


-23, 158) 


— 


State 


150 


— 


State 


151 


, (- 


-98, 168) , (- 


— 


State 


152 


— 


State 


153 


— 


State 


154 


, (' 


-66, 175) 


-- 


State 


155 


— 


State 


156 


— 


State 


157 


— 


State 


158 


— 


State 


159 


. (■ 


-97, 177) 


— 


State 


160 


-- 


State 


161 


— 


State 


162 


-- 


State 


163 


— 


State 


164 


— 


State 


165 


/ ( 


-41, 51) 


— 


State 


166 



150 ) 



156) 



166) 
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— State 167 

, (-98, 179) 

, (-40, 166) 

— State 168 

,(-106, 199), (-105, 198), (-104, 197) 

, (-102, 196) 

— State 169 

, (-98, 201) , (-40, 166) 

— State 170 
, (-98, 202) 

, (-40, 166) 

— State 171 

, (-98, 203) , (-40, 166) 

— State 172 
, (-98, 204) 

, (-40, 166) 

— State 173 

— State 174 
, (-84, 206) 

— State 175 
, (-65, 207) 

— State 176 
, (-71, 209) 

, (-35, 208) 

— State 177 

, (-98, 210) , (-40, 166) 

— State 178 

— State 179 

, (-106, 199) 

,(-105, 198), (-104, 197), (-102, 196) 



— 


state 


180 


— 


State 


181 


— 


State 


182 


— 


State 


183 


— 


State 


184 


— 


State 


185 


— 


State 


186 


— 


State 


187 


— 


State 


188 


— 


State 


189 





State 


190 
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state 



191 



State 


192 


State 


193 


State 


194 


State 


195 


State 


196 



, (-103, 213) 

— State 197 

, (-98, 214) , (-40, 166) 

— State 198 

, (-98, 215) , (-40, 166) 

— State 199 

, (-98, 216) , (-40, 166) 

— State 200 

, (-98, 217) , (-40, 166) 



— State 201 



, (-106, 199) , 1 


(-105, 


198) , 


(-104, 


197) , 


(-102, 


196) 


— State 202 
, (-106, 199) , 1 


(-105, 


198) , 


(-104, 


197) , 


(-102, 


196) 


— State 203 
, (-106, 199) , 1 


(-105, 


198) , 


(-104, 


197) , 


(-102, 


196) 


— State 204 
, (-106, 199) , 1 


(-105, 


198) , 


(-104, 


197) , 


(-102, 


196) 



— State 205 
, (-77, 218) 

— State 206 
, (-78, 220) 

— State 207 

— State 208 

— State 209 
, (-72, 222) 

— State 210 

, (-106, 199) 

,(-105, 198), (-104, 197), (-102, 196) 

— State 211 
, (-100, 223) 

— State 212 

— State 213 

, (-98, 224) , (-40, 166) 
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- State 


214 






(-106, 


199) , 1 


(-105, 


198) 


(-104, 


197) , 1 


(-102, 


196) 


- State 


215 






(-106, 


199) , 1 


(-105, 


198) 


(-104, 


197) , 1 


(-102, 


196) 


- State 


216 






(-106, 


199) , 1 


(-105, 


198) 


(-104, 


197) , 1 


(-102, 


196) 


- State 


217 






(-106, 


199) , 1 


(-105, 


198) 


(-104, 


197) , 1 


(-102, 


196) 



— state 218 
, (-78, 225) 

— State 219 
, (-92, 228) 

— State 220 
, (-79, 230) 

— State 221 

, (-65, 231) 

— State 222 

— State 223 

— State 224 

, (-106, 199) , (-105, 198) 
, (-104, 197) , (-102, 196) 

— State 225 
, (-79, 234) 

— State 226 
, (-94, 235) 

— State 227 
, (-95, 236) 

— State 228 
, (-93, 237) 

— State 229 

, (-107, 107) , (-36, 238) 

— State 230 

, (-80, 240) 

— State 231 

— State 232 

, (-71, 241) , (-35, 208) 

— State 233 

, (-101, 242) 

— State 234 
, (-80, 243) 

— State 235 
, (-35, 244) 

— State 236 
, (-35, 245) 
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— state 237 

, (-89, 247) 

— State 238 
, (-26, 248) 

— State 239 

— State 240 
, (-81, 251) 

— State 241 

— State 242 

, (-99, 151) , (-33, 

— State 243 

, (-81, 254) 

— State 244 

— State 245 

— State 246 

, (-107, 107) , (-87, 

, (-36, 258) 

— State 247 
, (-26, 269) 



State 


248 




State 
•107, 1 


249 
07) , ( 


-36, 


State 


250 




State 251 
■96, 272) , (- 
State 252 


•82, 


State 


253 




State 254 
•96, 272) , (- 


-82, 


State 


255 




State 


256 




State 


257 




State 


258 




State 


259 




State 


260 




State 


261 





253) 



264) 



270) 



274) 



276) 



, (-41, 51) 



(-40, 262) 
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state 262 



— State 263 
, (-113, 278) 

— State 264 

, (-106, 282) , (-105, 281) 

, (-104, 280) , (-102, 279) 

— State 265 
, (-116, 284) 

— State 266 
, (-117, 285) 

— State 267 
, (-121, 286) 

— State 268 
, (-122, 287) 

— State 269 

— State 270 
, (-26, 288) 

— State 271 

, (-107, 107) 

, (-36, 289) 

— State 272 

, (-107, 107) , (-36, 290) 

— State 273 

— State 274 

— State 275 

— State 276 

, (-83, 292) 

— State 277 

— State 278 

,(-107, 107), (-87, 294), (-40, 262), (-36, 258) 

— State 279 
, (-114, 295) 

— State 280 
, (-115, 296) 

— State 281 
, (-118, 297) 

— State 282 
, (-119, 298) 

— State 283 
, (-120, 299) 

— State 284 

,(-107, 107), (-87, 300), (-40, 262) 

, (-36, 258) 

— State 285 

,(-107, 107), (-87, 301), (-40, 262) 
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, (-36, 258) 

— State 286 

,(-107, 107), (-87, 302), (-40, 262) 

, (-36, 258) 

— State 287 

,(-107, 107), (-87, 303), (-40, 262) 

, (-36, 258) 

— State 288 

— State 289 

, (-26, 304) 

— State 290 
, (-26, 305) 

— State 291 



— State 292 
, (-90, 312) 



— State 293 
, (-111, 313) 

— State 294 

, (-106, 282) , (-105, 281) 

, (-102, 279) 

— State 295 

, (-107, 107) , (-87, 315) , 

, (-36, 258) 

— State 296 

, (-107, 107) , (-87, 316) , 

, (-36, 258) 

— State 297 

, (-107, 107) , (-87, 317) , 

, (-36, 258) 

— State 298 

, (-107, 107) , (-87, 318) , 

, (-36, 258) 

— State 299 

, (-107, 107) , (-87, 319) , 

, (-36, 258) 

— State 300 

, (-106, 282) , (-105, 281) 
, (-102, 279) 

— State 301 

, (-106, 282) , (-105, 281) 
, (-102, 279) 

— State 302 

, (-106, 282) , (-105, 281) 

, (-102, 279) 

— State 303 

, (-106, 282) , (-105, 281) 
, (-102, 279) 



State 


304 


State 


305 


State 


306 



, (-104, 280) 

(-40, 262) 

(-40, 262) 
(-40, 262) 
(-40, 262) 

(-40, 262) 

, (-104, 280) 

, (-104, 280) 
, (-104, 280) 

, (-104, 280) 
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state 



307 



— state 


308 




— State 


309 




— State 


310 




, (-85, 320) 




— State 


311 




— State 


312 




— State 


313 




— State 


314 




— State 


315 




, (-106, 


282) , ( 


-105, 


, (-104, 


280) , ( 


-102, 


— State 


316 




, (-106, 


282) , ( 


-105, 


/ (-104, 


280) , ( 


-102, 


— State 


317 




, (-106, 


282) , ( 


-105, 


, (-104, 


280) , ( 


-102, 


— State 


318 




, (-106, 


282) , ( 


-105, 


, (-104, 


280) , ( 


-102, 


— State 


319 




, (-106, 


282) , ( 


-105, 


, (-104, 


280) , ( 


-102, 



— State 320 
, (-35, 324) 

— State 321 
, (-88, 325) 

— State 322 
, (-91, 326) 

— State 323 

, (-112, 327) 

— State 324 

— State 325 
, (-89, 329) 

— State 326 

, (-89, 330) 

— State 327 

, (-110, 332) , (-108, 

— State 328 
, (-86, 333) 

— State 329 

, (-26, 334) 



281) 

279) 

281) 

279) 

281) 

279) 

281) 

279) 

281) 

279) 



331) 
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— state 330 

, (-26, 335) 

— State 331 

— State 332 

,(-107, 107), (-87, 338), (-40, 262) 

, (-36, 258) 

— State 333 

,(-107, 107), (-87, 339), (-40, 262) 

, (-36, 258) 

— State 334 

— State 335 

-- State 336 
, (-109, 340) 

— State 337 

— State 338 

, (-106, 282) , (-105, 281) 

, (-104, 280) , (-102, 279) 

— State 339 

, (-106, 282) , (-105, 281) 

,(-104, 280), (-102, 279), (-26, 341) 

— State 340 

, (-107, 107) 

,(-87, 342), (-40, 262), (-36, 258) 

— State 341 

— State 342 
, (-106, 282) 

,(-105, 281), (-104, 280), (-102, 279) 

) ; 

— The offset vector 

GOTO_OFFSET : array (0.. 342) of Integer 

( 0 , 



2, 3 


, 3, 4, 


4, 


7, 7, 


7, 


7, 7, 










7, 8 


, 9 , 1 0 j 


r 11 


, 12, 


13, 


, 14, 15, 


16 


, 






18, 


19, 19, 


22, 


25, 


25, 


28, 31, 


32, 


33, 


r 




33, 


34, 35, 


36, 


37, 


38, 


39, 40, 


40, 


41, 


r 




41, 


42, 43, 


43, 


43, 


44, 


44, 44, 


45, 


45, 


f 




CO 


48, 49, 


50, 


50, 


51, 


54, 57, 


60, 


63, 


f 




64, 


64, 65, 


65, 


66, 


66, 


66, 67, 


68, 


69, 


f 




69, 


71, 71, 


71, 


71, 


71, 


72, 72, 


73, 


73, 


f 




73, 


73, 73, 


73, 


73, 


74, 


74, 76, 


76, 


76, 


r 




77, 


78, 79, 


80, 


80, 


80, 


80, 81, 


82, 


82 






82, 


85, 85, 


85, 


85, 


85, 


85, 85, 


85, 


85 






00 

00 


89, 89, 


90, 


90, 


91, 


91, 92, 


92, 


93 


r 




94, 


94, 95, 


95, 


95, 


95, 


95, 95, 


95, 


95 






96, 


97, 97, 


98, 


99, 


99, 


99, 100, 


100, : 


101, 




103, 


104, 104, 


105, 


107, 


, 109, 109, 


109 


, 109, 


110 


110, 


112, 112, 


112, 


113, 


, 113, 113, 


113, 


, 113, 


114 


114, 


114, 114, 


114, 


114, 


, 115, 115, 


117, 


. 121, 


123 


125, 


127, 129, 


129, 


130, 


r 131, 133, 


135, 


r 135, 


139 


139, 


139, 139, 


139, 


139, 


r 139, 139, 


139 


, 139, 


139 
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139, 139, 

148, 152, 

171, 172, 

193, 194, 

205, 205, 
214, 214, 
224, 226, 
228, 229, 
239, 241, 
250, 251, 
271, 271, 
301, 305, 
314, 314, 

335, 336, 
345, 345, 
367, 367); 



139, 139, 
156, 160, 
172, 174, 
194, 194, 
207, 208, 
216, 217, 
226, 226, 
229, 230, 
243, 243, 
252, 253, 
272, 273, 
309, 313, 
314, 314, 
337, 338, 
349, 353, 



139, 139, 

164, 165, 

178, 182, 

198, 199, 

209, 210, 
217, 217, 
228, 228, 
234, 235, 
243, 243, 
257, 261, 

277, 281, 

313, 313, 

314, 318, 
338, 339, 
353, 353, 



140, 142, 
166, 166, 
186, 190, 
200 , 201 , 
211 , 212 , 
221 , 222 , 
228, 228, 
236, 237, 
244, 244, 
265, 269, 
285, 289, 
313, 313, 
322, 326, 
340, 342, 
354, 354, 



144, 146, 
166, 167, 
191, 192, 
202, 204, 
213, 213, 
222, 224, 
228, 228, 
238, 238, 
248, 249, 
269, 270, 
293, 297, 
313, 313, 
330, 334, 
343, 344, 
358, 363, 



subtype Rule is Natural; 

subtype Nonterminal is Integer; 



Rule_Length : 
0, 2, 0, 3, 0, 

5, 6, 0, 3, 0, 

0 , 0 , 6 , 0 , 0 , 

0, 0, 3, 0, 3, 

r Of 

0, 0, 5, 0, 0, 

Of 4, 1, 2, 0, 

Of 2, 0, 2, 0, 

5f 0, 0, 6, 0, 

4f 0, 6, 0, 4, 

8, 0, 0, 3, 0, 

If 0, 2, 0, 0, 

3f 0, 0, 4, 0, 

0 , 0 , 8 , 0 , 6 , 

0, 5, 0, 0, 3, 

2f 0, 4, 0, 4, 

3f If 1, 1, 2, 

Of 2, 1, 1, 1, 

3, 0, 0, 8, 3, 

2f 2, 3, 3, 3, 

If If If If If 

If If If If If 

2f 2, 2, 2, 1, 

2f If If If If 

3, 0, 0, 8, 0, 

Of 4, 0, 3, 0, 

Of 4, 0, 4, 0, 

Get_LHS_Rule: 
“3,~2, ~5,— 4, — 4,— 
-7,-10,-16,-12,- 
-19, -20, -14, “14, 
-24, -27,-25,-28, 
-31, -32,-25, -34, 
-38, -39, -37,-41, 



array (Rule range 0 
If If 0, 

Of 2, 0, 

3 f 4 , 3 , 

Of 3 , 0 , 

4 f 3 , 1 , 

Of 7, 1, 

3 , 0 , 3 , 

Of 5 , 0 , 

Of 5, 0, 

4f 0, 0, 

0, 7, 0, 

4, 0, 0, 

10 , 0 , 8 , 

Of 6, 0, 

Of 3, 0, 

Of 3, 0, 

Of 0, 4, 

If If If 
Of 4, 3, 

2f 2, 1, 

If If If 

If 1, 2, 

Of 4, 0, 

If If If 
4f 0, 4, 

3 , 0 , 4 , 

3, 0, 3); 

array (Rule range 0 
6f-6,-9, 
12,-18,-13,-13, 

-22, -8, -21, -24, 
-25,-29,-25, -30, 

-25, -25,-17,-17, 

-42, -43, -40,-40, 



216) of Natural := ( 2, 



216) of Nonterminal := (-1, 
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- 44 , - 35 , - 35 ; - 26 , - 26 , - 15 , - 48 , - 45 , 

-4 5,-4 6,-4 6,-4 7,-4 7,-4 9 ,- 11,-5 0 , 

- 11,-5 2,-5 3 ,- 51 ,- 51,-5 4 ,- 23,-5 6 , 
- 23 ,- 61,-5 5 , - 62 , - 57 ,- 63 ,- 63 ,- 67 , 

-6 4 ,- 64 ,- 68,-6 5,-7 0,-7 2 ,- 69 ,- 69 , 
- 71 ,- 71 ,- 66 ,- 66 ,- 73 ,- 58 ,- 58 ,- 74 , 
- 59 ,- 59 ,- 75 ,- 60 ,- 77 ,- 76 ,- 84 ,- 76 , 
- 85 ,- 86 ,- 83 ,- 88 ,- 83 ,- 91 ,- 83 ,- 83 , 
- 93 ,- 78 ,- 78 ,- 94 ,- 92 , - 95 ,- 92 ,- 92 , 

-7 9,-7 9,-8 0,-8 0 ,- 81 ,- 81 ,- 82 ,- 82 , 

-9 6 ,- 90 ,- 90 ,- 90,-8 9,-8 9,-9 7,-3 3 , 

-9 9,-3 3 ,- 98 ,- 98 ,- 98 ,- 98 ,- 98 ,- 98 , 

-9 8 ,- 100 ,- 101,-9 8,-9 8 ,- 103 ,- 98,-9 8 , 
- 98 ,- 98,-9 8,-9 8 ,- 98 ,- 98,-9 8 ,- 102 , 
- 102 ,- 102 ,- 104 ,- 104 ,- 104 ,- 104 ,- 104 ,- 104 , 
- 105 ,- 105 ,- 105 ,- 106 ,- 106 ,- 106 ,- 106 ,- 36 , 
-3 6,-3 6,-3 6,-3 6 ,- 107,-10 9 ,- 108 ,- 110 , 

-10 8 ,- 87 ,- 87 ,- 87 ,- 87 ,- 87 ,- 87 ,- 87 , 
- 87 ,- 111 ,- 112 ,- 87 ,- 113 ,- 87 ,- 114 ,- 87 , 
- 115 ,- 87 ,- 116 ,- 87 , - 117 ,- 87 , - 118 ,- 87 , 
- 119 , - 87 , - 120 , - 87 , - 121 , - 87 , - 122 , - 87 ) / 
end Psdl_Goto; 
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APPENDIX W. PACKAGE PSDL SHIFT REDUCE 



package Psdl_Shif t_Reduce is 

type Small_Integer is range -32_000 . . 32_000; 

type Shif t_Reduce_Entry is record 
T ; Small_Integer ; 

Act : Small_Integer ; 
end record; 

pragma Pack (Shift_Reduce_Entry ) ; 

subtype Row is Integer range -1 .. Integer' Last ; 

— pragma suppress ( index^check) / 



type Shif t_Reduce_Array 

is array (Row range <>) of Shif t_Reduce_Entry ; 

Shif t_Reduce_Mat rix : constant Shif t_Reduce_Array := 

( (-1,-1) — Dummy Entry 

— state 0 
, (-1,-1) 

— state 1 
, (-1,-5) 

— state 2 

, ( 0,-1001) , (-1,-1000) 

— state 3 

, ( 44,-3) , ( 59,-3) , (-1,-2) 

— state 4 
, (-1,-1000) 

— state 5 

, ( 44, 9) , ( 59, 8) , (-1,-1000) 

— state 6 

/ (- 1 ,- 6 ) 

— state 7 
, (-1,-7) 

— state 8 

, ( 62, 11) , (-1,-1000) 

— state 9 
, ( 62, 12) 

, (-1,-1000) 



- state 


10 


(-1,-4) 




- state 


11 


(-1,-8) 




- state 


12 
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; (- 1 ,- 21 ) 



— state 13 

, ( 51, 15) , (-1,-lOOOj 

— state 14 

, ( 51, 17) , (-1,-1000) 

— state 15 

, ( 29, 19) , (-1,-13) 

— state 16 

, ( 33, 21) , (-1,-1000) 

— state 17 
, (-1,-25) 

-- state 18 
, ( 33, 24) , (-1,-1000) 

— state 19 

, (- 1 ,- 11 ) 

— state 20 

, ( 62,-14) , (-1,-16) 

— state 21 

, ( 13, 30) , ( 62, 29) 

, (- 1 ,- 1000 ) 

— state 22 
, (-1,-9) 

— state 23 



25, 


37) , 


( 29, 


33) 






35, 


34) , 


( 36, 


39) , 


( 37, 38) , 


( 46, 35) 


53, 


36) , 


(-1,- 


•57) 







— state 24 
, ( 13, 44) , (-1,-76) 



— state 


25 


, (-1,-22) 




— state 


26 


, (-1,-41) 




— state 


27 


, (-1,-41) 




— state 


28 


, (-1,-20) 




— state 


29 


, ( 5,-44) , 


(-1,-48) 


— state 


30 


, ( 62, 52) 


, (-1,-1000) 


— state 


31 


, (-1,-64) 




— state 


32 


, ( 22, 54) 


, (-1,-59) 


— state 


33 


, (-1,-26) 




— state 


34 
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35 



, (-1,-28) 

— state 
, (-1,-30) 

— state 36 
, (-1,-32) 

— state 37 
, (-1,-36) 

— state 38 

, ( 27, 61) , (-1,-1000) 

— state 39 
, (-1,-55) 

— state 40 

, ( 24, 63) 

, (-1,-1000) 

— state 41 

, ( 16, 64) , (-1,-53) 

— state 42 
, ( 21, 66) 

, (-1,-95) 

— state 43 

, ( 30, 68) , (-1,-1000) 

— state 44 

, ( 62, 69) 

, (-1,-1000) 

— state 45 
, (-1,-72) 

— state 46 

, ( 4, 71), (-1,-12) 

— state 47 
, (-1,-40) 

— state 48 

, ( 62, 73) , (-1,-1000) 

— state 49 
, ( 4, 71) 

, (-1,-15) 

— state 50 

, ( 36, 39) , ( 44, -17) , (-1,-57) 

— state 51 

, ( 5, 76) , (-1,-1000) 

— state 52 
, (-1,-62) 

— state 53 
, (-1,-69) 

— state 54 

, ( 66, 79) , (-1,-1000) 

— state 55 

, ( 14, 80) , (-1,-61) 

— state 56 
, (-1,-41) 

— state 57 
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58 



, (-1,-41) 

— state 
, (-1,-41) 

— state 59 
, (-1,-41) 

— state 60 

, ( 62, 73) , (-1,-1000) 

— state 61 

, ( 56, 87) , (-1,-1000) 

— state 62 

, ( 62, 73) , (-1,-1000) 

— state 63 
, (-1,-23) 

— state 64 

, ( 62, 73) 

, (-1,-1000) 

— state 65 
, (-1,-24) 

— state 66 

, ( 55, 90) , (-1,-1000) 

— state 67 

, ( 57, 91) , (-1,-98) 

— state 68 
, (-1,-79) 

— state 69 
, (-1,-70) 

— state 70 

, ( 24, 95) , (-1,-1000) 

— state 71 
, (-1,-41) 

— state 72 

, ( 4, 98) 

, ( 7, 97) , (-1,-1000) 

— state 73 
, (-1,-51) 

— state 74 

, ( 24, 99) 

, (-1,-1000) 

— state 75 

, ( 44, 100) , (-1,-1000) 

— state 76 
, (-1,-45) 

— state 77 

, ( 24, 102) , (-1,-1000) 

— state 78 

, ( 24, 103) , (-1,-66) 

— state 79 
, (-1,-58) 

— state 80 
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, ( 


66, 105) , (-1,-1000) 


— 


state 


81 


, (- 


•1,-54) 




— 


state 


82 


. ( 


4, 71), 


(-1,-27) 


— 


state 


83 


, ( 


4, 71), 


(-1,-29) 


— 


state 


84 


. ( 


4, 71), 


(-1,-31) 


— 


state 


85 


. ( 


1 — 1 


(-1,-33) 


— 


state 


86 


. ( 


00 


(-1,-37) 


— 


state 


87 


/ ( 


63, 108) , (-1,-1000) 


— 


state 


88 


, ( 


4, 98), 


(-1,-56) 


— 


state 


89 


/ ( 


CO 

ch 


(-1,-52) 


— 


state 


90 


, (■ 


-1,-93) 




— 


state 


91 


. (• 


-1,-96) 




— 


state 


92 


, ( 


19, 112) , (-1, -1000) 


— 


State 


93 


, ( 


60, 115) , (-1, -82) 


— 


state 


94 


. ( 


24, 116) , (-1, -1000) 


— 


state 


95 


, ( 


-1,-73) 




— 


state 


96 


, ( 


-1,-39) 




— 


state 


97 


, ( 


-1,-42) 




— 


state 


98 


/ ( 


-1,-49) 




— 


state 


99 


, ( 


-1,-10) 




— 


state 


100 


, ( 


62, 119) , (-1,-1000) 


— 


state 


101 


. ( 


-1,-41) 




— 


state 


102 


, ( 


00 

1 

1 — 1 
1 




— 


state 


103 
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, (-1,-65) 

— state 104 

, ( 44, 121) , (-1,-1000) 

— state 105 
, (-1,-60) 

— state 106 

, ( 34, 122) , (-1,-1000) 

— state 107 

, ( 31, 127) 

,( 39, 123), { 40, 126), ( 41, 124), ( 50, 125) 

, (-1,-1000) 

— state 108 
, (-1,-181) 

-- state 109 
, (-1,-38) 

— state 110 
, (-1,-41) 

— state 111 

, ( 62, 73) , (-1,-1000) 

— state 112 

, ( 20, 130) , (-1, -1000) 

— state 113 
, (-1,-74) 

— state 114 

, ( 23, 132) , (-1,-77) 

— state 115 
, ( 62, 133) 

, (-1,-1000) 

— state 116 
, (-1,-71) 

— state 117 

, ( 62, 29) , (-1,-1000) 

— state 118 

, ( 62, 136) , (-1,-1000) 

— state 119 
, (-1,-18) 

— state 120 

, ( 4, 71) 

, (-1,-46) 

— state 121 

, ( 62, 139) , (-1,-1000) 

— state 122 
, (-1,-34) 



— state 123 
, (-1,-176) 

— state 124 
, (-1,-177) 

— state 125 
, (-1,-178) 

— state 126 



407 



(-1,-179) 



— state 127 
, (-1,-180) 

— state 128 

, ( 4, 71) , (-1,-94) 

— state 129 

, ( 4, 98) 

, (-1,-97) 

— state 130 

, (-1,-99) 

-- state 131 
, ( 22, 54) , (-1,-59) 

— state 132 

, ( 62, 143) , (-1,-1000) 

— state 133 
, (-1,-83) 

— state 134 

, ( 7, 145) 

, (-1,-92) 

— state 135 
, (-1,-43) 

— state 136 
, (-1,-50) 

— state 137 
, ( 51, 17) 

, (-1,-1000) 

— state 138 

, ( 6, 148) , (-1,-1000) 

— state 139 
, (-1,-67) 

— state 140 
, (-1,-137) 

— state 141 

, ( 44, 153) , (-1,-1000) 

— state 142 
, (-1,-75) 

— state 143 
, (-1,-80) 

— state 144 

, ( 7,-88) , ( 10,-88) , ( 19,-88) 

,( 21,-88), ( 23,-88), ( 57,-88), ( 60,-88) 
, (-1,-85) 

— state 145 

, ( 63, 108) , (-1,-1000) 



- state 


146 


(-1,-78) 




- state 


147 


(-1,-19) 




- state 


148 


(-1,-47) 
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— state 149 

, ( 33, 24) , (-1,-1000) 

— state 150 

, ( 4, 159) , (-1,-35) 

— state 151 



, ( 2, 


167) , ( 


11, 


160) 










, ( 12, 161) , 


( 43, 


171), 


( 62, 


165) , ( 


63, 


162) 


, ( 64, 163) , 


( 65, 


164), 


( 77, 


170) , ( 


CD 


169) 


, ( 87, 


172) , 


(-1, -1000) 











- state 


152 


( 44, 173) , (-1,-100) 


•- state 


153 


( 62, 174) , (-1, -1000) 


- state 


154 


( 7, 145) 


, (-1,-92) 


- state 


155 


( 2, 176) 


o 

o 

0 

t — 1 

1 

«— ( 
1 


- state 


156 


CO 

1 

< — 1 
1 




- state 


157 


1 

< — 1 
1 




- State 


158 


CO 

U) 

1 

t — 1 




•- state 


159 


(-1,-135) 




•- state 


160 


(-1,-139) 




- state 


161 


(-1,-140) 




•- state 


162 


(-1,-141) 




■- state 


163 


(-1,-142) 




-- state 


164 


(-1,-143) 




- state 


165 


( 5,-44) 




CO 

1 

CO 


(-1,-144) 


-- state 


166 



, ( 8, 178) , (-1,-1000) 



— state 167 



( 2, 


167) , ( 


11, 


160) , ( 


12, 


161) , ( 


43, 


171) 


( 62, 


165) , ( 


63, 


162) , 


( 64, 


163) , 


( 65^ 


r 164) 


( 77, 


170) , ( 


78, 


169) , 


( 87, 


172) , 


(-1,- 


-1000) 


- state 168 














( 42, 


194) , ( 


45, 


181) , 


( 67, 


180) , 


( 68^ 


r 182) 


( 70, 


183) , ( 


71, 


184) , 


( 72, 


185) , 


( 73^ 


r 186) 


( 74, 


187) , ( 


75, 


188) , 


( 77, 


189) , 


( 78, 


, 190) 
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, ( 79, 191) , ( 


82, 192), 


( 


83, 


193) , 


( 


CO 


195) 


, ( 86, 200) , ( 


-1,-138) 














— state 169 
















, ( 2, 167) , ( 


11, 160) 














, ( 12, 161) , ( 


43, 171), 


( 


62, 


165) , 


( 


63, 


162) 


, ( 64, 163) , ( 


65, 164), 


( 


77, 


170) , 


( 


CO 


169) 


, ( 87, 172) , ( 


-1, -1000) 














— state 170 
















, ( 2, 167) , ( 


11, 160) 














, ( 12, 161) , ( 


43, 171), 


( 


62, 


165) , 


( 


63, 


162) 


, ( 64, 163) , ( 


65, 164), 


( 


77, 


170) , 


( 


78, 


169) 


, ( 87, 172) , ( 


-1,-1000) 














-- state 171 
















, ( 2, 167) , ( 


11, 160) 














, ( 12, 161) , ( 


43, 171), 


( 


62, 


165) , 


( 


63, 


162) 


, ( 64, 163) , ( 


65, 164), 


( 


77, 


170) , 


( 


78, 


169) 


, ( 87, 172) , ( 


-1, -1000) 















— state 172 



2, 167) , ( 


11, 


160) 








12, 161), 


( 43, 


171) , ( 62, 


165) , ( 


63, 


162) 


64, 163), 


( 65, 


164) , ( 77, 


170) , ( 


78, 


169) 


87, 172), 


(-1, - 


•1000) 









— state 173 

, ( 62, 205) , (-1, -1000) 

— state 174 
, (-1,-103) 

-- state 175 
, ( 62, 133) , (-1, -1000) 

— state 176 

, ( 62, 73) 

, (-1,-90) 

— state 177 



( 2, 167) , ( 


11, 


160) , ( 


12, 161) 






( 43, 171) , ( 


62, 


165) , 


( 63, 162) , ( 


64, 


163) 


( 65, 164) , ( 

(-1,-1000) 


■77, 


170) , 


( 78, 169) , ( 


CO 


172) 


- state 178 












( 62, 211) , ( 


-1, - 


1000) 








- state 179 












( 3, 212) 

( 42, 194) , ( 


45, 


181) , 


( 67, 180) , ( 


CO 


182) 


( 70, 183) , ( 


71, 


184) , 


( 72, 185) , ( 


73, 


186) 


( 74, 187) , ( 


75, 


188) , 


( 77, 189) , ( 


78, 


190) 


( 79, 191) , ( 


CM 

CO 


192) , 


( 83, 193) , ( 


CO 


195) 


( 86, 200) , ( 


-1, - 


1000) 









- state 


180 


(-1,-160) 




- state 


181 


(-1,-161) 




- state 


182 


(-1,-162) 




- state 


183 


(-1,-163) 
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- state 


184 


(-1,-164) 




- state 


185 


(-1,-165) 




- state 


186 


(-1,-166) 




- state 


187 


(-1,-167) 




- state 


188 


(-1,-168) 




- state 


189 


(-1,-169) 




- state 


190 


(-1,-170) 




•- state 


191 


(-1,-171) 




’- state 


192 


(-1,-172) 




- state 


193 


(-1,-173) 




- state 


194 


(-1,-174) 




- state 


195 


(-1,-175) 




- state 


196 


(-1,-150) 




•- state 


197 



, ( 


2, 167) 






, ( 


11, 160) , ( 


12, 


161) , 


, ( 


63, 162) , ( 


64, 


163) , 


, ( 


78, 169) , ( 


87, 


172) , 


— 


state 198 






, ( 


2, 167) 






, ( 


11, 160) , ( 


12, 


161) , 


, ( 


63, 162) , ( 


64, 


163) , 


, ( 


78, 169) , ( 


87, 


172) , 


— 


state 199 






, ( 


2, 167) 






, ( 


11, 160) , ( 


12, 


161) , 


, ( 


63, 162) , ( 


64, 


163) , 


, ( 


78, 169) , ( 


87, 


172) , 


— 


state 200 






, ( 


2, 167) 






, ( 


11, 160) , ( 


12, 


161) , 


, ( 


63, 162) , ( 


64, 


163) , 


, ( 


78, 169) , ( 


00 


172) , 


— 


state 201 






, ( 


42, 194) 






, ( 


82, 192) , ( 


83, 


193) , 


, (■ 


-1,-153) 






— 


state 202 






, ( 


42, 194) , ( 


CM 

CO 


192) , 



( 43, 171) , ( 62, 165) 
( 65, 164) , ( 77, 170) 
(- 1 ,- 1000 ) 



( 43, 171) , ( 62, 165) 
( 65, 164) , ( 77, 170) 
(- 1 ,- 1000 ) 



( 43, 171) , ( 62, 165) 

( 65, 164) , ( 77, 170) 

(- 1 , - 1000 ) 



( 43, 171) , ( 62, 165) 
( 65, 164) , ( 77, 170) 
(- 1 ,- 1000 ) 



( 84, 195) , ( 86, 200) 



( 83, 193) 



411 



, ( 


84, 195) , ( 


86, 200) , 


(-1,-154) 




— 


state 203 








. (• 


-1,-158) 








— 


state 204 








, (• 


-1,-159) 








— 


state 205 








/ (■ 


-1,-101) 








— 


state 206 








, ( 


58, 219) , (■ 


-1,-115) 






-- 


state 207 








, ( 


10, 221) , (• 


-1, -1000) 






— 


state 208 








, ( 


1— 1 
1 

00 


,-89) 






— 


state 209 








, (■ 


00 

1 

»— 1 
1 








— 


state 210 








/ ( 


42, 194) , ( 


45, 181), 


( 67, 180) 




/ ( 


68, 182) , ( 


70, 183), 


( 71, 184) , 


( 72, 185) 


/ ( 


73, 186) , ( 


74, 187), 


( 75, 188) , 


( 77, 189) 


/ ( 


78, 190) , ( 


79, 191), 


( 82, 192), 


( 83, 193) 


, ( 


84, 195) , ( 


86, 200), 


(-1,-136) 




— 


state 211 








, ( 


3,-145) 








, ( 


4,-145) , ( 


14,-145) , ( 


16,-145) , ( 


22, -145) 


, ( 


24,-145), ( 


25,-145) , 


( 29,-145), 


( 35,-145) 


, ( 


36,-145), ( 


37,-145) , 


( 42,-145), 


( 45,-145) 


, ( 


46, -145) , ( 


53,-145) , 


( 67,-145), 


( 68,-145) 


/ ( 


70,-145) , ( 


71,-145) , 


( 72,-145), 


( 73,-145) 


, ( 


74,-145) , ( 


75,-145) , 


( 77,-145), 


( 78,-145) 


/ ( 


79,-145) , ( 


82,-145) , 


( 83,-145), 


( 84,-145) 


A ( 


86,-145) , ( 


-1, -146) 






— 


state 212 








, ( 


-1,-149) 








— 


state 213 








/ ( 


2, 167) 








, ( 


11, 160) , ( 


12, 161), 


( 43, 171) , 


( 62, 165) 


/ ( 


63, 162) , ( 


64, 163), 


( 65, 164), 


( 77, 170) 


/ ( 


78, 169) , ( 


87, 172), 


(-1,-1000) 




— 


state 214 








/ ( 


42, 194) 








/ ( 


77, 189) , ( 


78, 190), 


( 79, 191), 


( 82, 192) 


/ ( 


83, 193) , ( 


84, 195), 


( 86, 200), 


(-1,-152) 


— 


state 215 








/ ( 


o 

o 

CM 

CD 

CO 


-1,-155) 






— 


state 216 








/ ( 


86, 200) , ( 


-1,-156) 






— 


state 217 








/ ( 


-1,-157) 








— 


state 218 








/ ( 


58, 219) , ( 


-1,-115) 
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— state 219 

, ( 15, 226) 

, ( 17, 227) , (-1, -120) 

— state 220 

, ( 47, 229) , (-1,-122) 

— state 221 

, ( 62, 133) , (-1,-1000) 

— state 222 

, ( 9, 232) , (-1,-1000) 

— state 223 

, ( 2, 233) , (-1,-1000) 

— state 224 



( 42, 


194) , ( 


70, 


183) 










( 71, 


184) , ( 


72, 


185) , 


( 73, 


186) , 


( '/4, 


187) 


( 75, 


188) , ( 


77, 


189) , 


00 


190) , 


( 79, 


191) 


( 82, 192) , ( 
(-1,-151) 


83, 


193) , 


( 84, 


195) , 


( 86, 


200) 



— state 225 
, ( 47, 229) , (-1,-122) 
-- state 226 
, (-1,-116) 



— state 227 
, (-1,-118) 

-- state 228 
, (-1,-113) 

— state 229 

, ( 63, 108) , (-1, -1000) 

— state 230 

, ( 28, 239) , (-1,-124) 

— state 231 
, (-1,-81) 

— state 232 
, ( 62, 73) 

, (-1,-90) 

— state 233 
, (-1,-147) 

— state 234 

, ( 28, 239) , (-1, -124) 

— state 235 

, ( 62, 73) , (-1, -1000) 

— state 236 

, ( 62, 73) , (-1,-1000) 

— state 237 

, ( 32, 246) , (-1,-134) 

— state 238 

, ( 16, 64) , (-1,-53) 

— state 239 

, ( 61, 249) , (-1, -1000) 
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— state 240 

, ( 38, 250) , (-1, -126) 

— state 241 

, ( 3, 252) , (-1,-1000) 

— state 242 
, (-1,-137) 

— state 243 
, ( 38, 250) 

/ (-1,-126) 

— state 244 

, ( 4, 98) , (-1,-117) 

-- state 245 
, ( 4, 98) 

, (-1,-119) 

— state 246 

, ( 2, 263) , ( 11, 255) , ( 12, 256) 

,( 43, 267), ( 62, 261), ( 63, 257), ( 64, 259) 
,( 65, 260), ( 77, 266), ( 78, 265), ( 87, 268) 
, (-1,-1000) 

— state 247 

, ( 16, 64) , (-1,-53) 

— state 248 
, (-1,-121) 

— state 249 

, ( 63, 108) , (-1, -1000) 

— state 250 

, ( 18, 271) , (-1,-1000) 

— state 251 

, ( 37, 273) , (-1, -128) 

— state 252 
r (-1,-87) 

— state 253 
, ( 3, 275) 

, ( 4, 159) , (-1,-1000) 

— state 254 

, ( 37, 273) , (-1,-128) 

— state 255 
, (-1,-186) 

— state 256 
, (-1,-187) 

— state 257 

, ( 31,-181), ( 39,-181) 

,( 40,-181), ( 41,-181), ( 50, -181) , (-1, -188) 

— state 258 
, (-1,-189) 

— state 259 
, (-1,-190) 

— state 260 
, (-1,-191) 

— state 261 



414 



, ( 5,-44) 

, ( 8,-48) , (-1,-192) 

— state 262 

, ( 8, 277) , (-1,-1000) 

— state 263 
, (-1,-197) 

— state 264 



42, 


194) , ( 


45, 


181) , 


( 67, 180) 






68, 


182) , ( 


70, 


183) , 


( 71, 184) , ( 


72, 


185) 


73, 


186) , ( 


74, 


187) , 


( 75, 188) , ( 


77, 


189) 


CO 


190) , ( 


79, 


191) , 


( 82, 192) , ( 


00 


193) 


00 


195) , ( 


86, 


283) , 


(-1,-133) 







— state 265 
, (-1,-203) 

— state 266 
, (-1,-205) 

— state 267 
, (-1,-213) 

— state 268 
, (-1,-215) 

— state 269 
, (-1,-114) 

— state 270 

, ( 16, 64) , (-1,-53) 

— state 271 

, ( 63, 108) , (-1, -1000) 



-- state 272 
, ( 63, 108) , (-1,-1000) 

— state 273 

, ( 49, 291) , (-1,-1000) 

— state 274 
, (-1,-104) 

— state 275 
, (-1,-148) 

— state 276 

, (- 1 ,- 112 ) 

— state 277 
, ( 62, 293) 

, (- 1 ,- 1000 ) 

— state 278 



263) , ( 


11, 255) , ( 


12, 256) 






267) , 


( 62, 261) , 


( 63, 257), 


( 64, 


259) 


260) , 


( 77, 266) , 


( 78, 265), 


00 


268) 



, (- 1 ,- 1000 ) 

— state 279 
, (-1,-199) 

— state 280 

, (- 1 ,- 201 ) 

— state 281 
, (-1,-207) 



415 



— state 282 
, (-1,-209) 

— state 283 

, (- 1 ,- 211 ) 

— state 284 



, ( 


2, 263) , ( 


11, 255) 






, ( 


12, 256) , ( 


43, 267), 


( 62, 261), 


( 63, 257) 


. ( 


64, 259) , ( 


65, 260), 


( 77, 266), 


( 78, 265) 


, ( 


87, 268) , ( 


-1, -1000) 






— 


state 285 








, ( 


2, 263) , ( 


11, 255) 






r ( 


12, 256) , ( 


43, 267), 


( 62, 261), 


( 63, 257) 


, ( 


64, 259) , ( 


65, 260), 


( 77, 266), 


( 78, 265) 


, ( 


87, 268) , ( 


-1, -1000) 






— 


state 286 








/ ( 


2, 263) , ( 


11, 255) 






, ( 


12, 256) , ( 


43, 267), 


( 62, 261), 


( 63, 257) 


, ( 


64, 259) , ( 


65, 260), 


( 77, 266), 


( 78, 265) 


, ( 


87, 268) , ( 


-1, -1000) 






— 


state 287 








, ( 


2, 263) , ( 


11, 255) 






, ( 


12, 256) , ( 


43, 267), 


( 62, 261), 


( 63, 257) 


. ( 


64, 259) , ( 


65, 260), 


( 77, 266), 


( 78, 265) 


, ( 


87, 268) , ( 


-1, -1000) 






— 


state 288 








r ( 


-1,-123) 








— 


state 289 








/ ( 


16, 64) 








, ( 


-1,-53) 








— 


state 290 








r ( 


16, 64) , (- 


1,-53) 






— 


state 291 








r ( 


56, 306) 








r ( 


-1,-1000) 








— 


state 292 








, ( 


26, 311) , ( 


46, 310), 


( 48, 307) 




, ( 


52, 308) , ( 


54, 309), 


(-1,-102) 




— 


state 293 








r ( 


3,-193) 








. ( 


4,-193) , ( 


16, -193) , ( 


22,-193) , ( 


24, -193) 


, ( 


26, -193) , ( 


28,-193) , 


( 37,-193), 


( 38,-193) 


r ( 


42,-193) , ( 


44,-193) , 


( 45,-193), 


( 46,-193) 


r ( 


47, -193) , ( 


48,-193) , 


( 52,-193), 


( 54,-193) 


. ( 


67,-193) , ( 


68, -193) , 


( 70,-193), 


( 71,-193) 


, ( 


72,-193) , ( 


73,-193) , 


( 74,-193), 


( 75,-193) 


, ( 


77,-193) , ( 


78,-193) , 


( 79,-193), 


( 82,-193) 


r ( 


83, -193) , ( 


84,-193) , 


( 86,-193), 


(-1, -194) 


— 


state 294 








, ( 


3, 314) , ( 


42, 194) , ( 


45, 181) , ( 


67, 180) 


, ( 


68, 182) , ( 


70, 183), 


( 71, 184), 


( 72, 185) 


, ( 


73, 186) , ( 


74, 187), 


( 75, 188) , 


( 77, 189) 


, ( 


78, 190) , ( 


79, 191), 


( 82, 192) , 


( 83, 193) 


. ( 


84, 195) , ( 


86, 283), 


(-1,-1000) 
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— state 295 



, ( 


2, 263) 












, ( 


11, 255) , ( 


12, 


256) , 


( 43, 267) , ( 


62, 


261) 


, ( 


63, 257) , ( 


64, 


259) , 


( 65, 260) , ( 


77, 


266) 


, ( 


78, 265) , ( 


87, 


268) , 


(-1,-1000) 






— 


state 296 












, ( 


2, 263) 












, ( 


11, 255) , ( 


12, 


256) , 


( 43, 267) , ( 


62, 


261) 


, ( 


63, 257) , ( 


64, 


259) , 


( 65, 260) , ( 


77, 


266) 


, ( 


78, 265) , ( 


87, 


268) , 


(-1,-1000) 






— 


state 297 












, ( 


2, 263) 












, ( 


11, 255) , ( 


12, 


256) , 


( 43, 267) , ( 


62, 


261) 


, ( 


63, 257) , ( 


64, 


259) , 


( 65, 260) , ( 


77, 


266) 


, ( 


78, 265) , ( 


87, 


268) , 


(-1,-1000) 






— 


state 298 












, ( 


2, 263) 












, ( 


11, 255) , ( 


12, 


256) , 


( 43, 267) , ( 


62, 


261) 


, ( 


63, 257) , ( 


64, 


259) , 


( 65, 260) , ( 


77, 


266) 


, ( 


78, 265) , ( 


87, 


268) , 


(-1,-1000) 






— 


state 299 












, ( 


2, 263) 












/ ( 


11, 255) , ( 


12, 


256) , 


( 43, 267) , ( 


62, 


261) 


/ ( 


63, 257) , ( 


64, 


259) , 


( 65, 260) , ( 


77, 


266) 


, ( 


78, 265) , ( 


87, 


CD 

CD 

CM 


(-1, -1000) 






— 


state 300 












, ( 


42, 194) 












, ( 


82, 192) , ( 


83, 


193) , 


( 84, 195) , ( 


86, 


283) 


/ (■ 


-1,-204) 












— 


state 301 












, ( 


42, 194) , ( 


82, 


192) , 


( 83, 193) 






, ( 


84, 195) , ( 


86, 


283) , > 


(-1,-206) 







- state 


302 


(-1,-214) 




- state 


303 


(-1,-216) 




- state 


304 


(’1,-125) 




- state 


305 


(-1,-127) 




- state 


306 


(-1,-129) 




- state 


307 


(-1,-130) 




- state 


308 


(-1,-131) 




- state 


309 


(-1,-132) 




- state 


310 


(-1,-105) 




- state 


311 



, ( 62, 321) , (-1, -1000) 



417 



— state 312 

, ( 62, 322) , (-1, -1000) 

— state 313 

, ( 2, 323) , (-1,-1000) 

— state 314 
, (-1,-198) 

— state 315 



42, 


194) 






70, 


183) , ( 


71, 


184) 


74, 


187) , ( 


75, 


188) 


79, 


191) , ( 


82, 


192) 


00 


283) , (• 


-1,- 


200) 


state 316 






42, 


194) , ( 


77, 


189) 


78, 


190) , ( 


79, 


191) 


00 


195) , ( 


00 


283) 


state 317 






42, 


194) 






82, 


192) , ( 


00 


193) 



, (-1,-208) 

— state 318 

, ( 86, 283) , (-1,-210) 

— state 319 
, (-1,-212) 

— state 320 

, ( 62, 73) , (-1,-1000) 

— state 321 
, (-1,-108) 

— state 322 
, (-1,-110) 

— state 323 
, (-1,-195) 

— state 324 

, ( 4, 98) , ( 32, 328) , ( 

— state 325 

, ( 32, 246) , (-1,-134) 

— state 326 

, ( 32, 246) , (-1,-134) 

— state 327 
, (-1,-184) 

— state 328 
, (-1,-106) 

— state 329 

, ( 16, 64) , (-1,-53) 

— state 330 

, ( 16, 64) , (-1,-53) 

— state 331 

, ( 3, 337) , ( 4, 336) 

, (-1,-1000) 



72, 


185) , ( 


73, 


186) 


77, 


189) , ( 


78, 


190) 


83, 


193) , ( 


84, 


195) 


82, 


192) , ( 


83, 


193) 


1,- 


202) 






84, 


195) , ( 


86, 


283) 



1 ,- 1000 ) 
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— state 332 



, ( 


2, 263) , ( 


11, 255) , ( 


12, 256) 






, ( 


43, 267) , ( 


62, 261), 


( 63, 257) , ( 


64, 


259) 


, ( 


65, 260) , ( 


77, 266), 


( 78, 265) , ( 


87, 


268) 


, ( 


-1,-1000) 










— 


state 333 










, ( 


2, 263) , ( 


11, 255) , ( 


12, 256) 






/ ( 


43, 267) , ( 


62, 261), 


( 63, 257) , ( 


64, 


259) 


, ( 


65, 260) , ( 


77, 266) , 


( 78, 265) , ( 


87, 


268) 



(-1,-1000) 


- state 


334 


(-1,-109) 




- state 


335 


(-1,-111) 




- state 


336 


(-1,-182) 




- state 


337 


(-1,-196) 




- state 


338 



, ( 


42, 194) , ( 


45, 


r 181), 


( 6-7, 


180) 






, ( 


68, 182) , ( 


70, 


, 183), 


( 71, 


184) , ( 


72, 


185) 


, ( 


73, 186) , ( 


74, 


r 187), 


( 75, 


188) , ( 


77, 


189) 


/ ( 


78, 190) , ( 


79, 


, 191), 


<N1 

00 


192) , ( 


83, 


193) 


, ( 


84, 195) , ( 


86, 


, 283), 


(-1,- 


185) 






— 


state 339 














, ( 


1— 1 














, ( 


42, 194) , ( 


45, 


, 181), 


( 67, 


180) , ( 


68, 


182) 


/ ( 


70, 183) , ( 


71, 


, 184), 


( 72, 


185) , ( 


73, 


186) 


/ ( 


74, 187) , ( 


75, 


, 188), 


( 77, 


189) , ( 


78, 


190) 


, ( 


79, 191) , ( 


82, 


, 192), 


( 83, 


193) , ( 


84, 


195) 


. ( 


86, 283) , ( 


-1,- 


-53) 










— 


state 340 














, ( 


2, 263) , ( 


11, 


255) 










, ( 


12, 256) , ( 


43, 


, 267), 


( 62, 


261) , ( 


63, 


257) 


, ( 


64, 259) , ( 


65, 


, 260), 


( 77, 


CM 


78, 


265) 


, ( 


87, 268) , ( 


-1,- 


-1000) 










— 


state 341 














, (■ 


-1,-107) 














— 


state 342 














, ( 


42, 194) 














, ( 


< — 1 
00 
< — 1 

IT) 


67 


, 180), 


( 68, 


CM 
00 
1 — 1 


70, 


183) 


, ( 


71, 184) , ( 


72 


, 185), 


( 73, 


186) , ( 


74, 


187) 


, ( 


75, 188) , ( 


77 


, 189), 


( 78, 


190) , ( 


79, 


191) 


, ( 


82, 192) , ( 


83 


, 193), 


( 84, 


195) , ( 


86, 


283) 



, (-1,-183) 

) ; 

— The offset vector 

SHIFT_REDUCE_OFFSET : array (0.. 342) of Integer 



0, 

1, 


2, 4. 


. 7, 


8, 


11, 


12, 


13, 


15, 


17, 




18, 


19, 


20, 


22, 


24, 


26, 


28, 


29, 


31, 


32 


34, 


37, 


38, 


46, 


48, 


49, 


50, 


51, 


52, 


54 


56, 


57, 


59, 


60, 


61, 


62, 


63, 


64, 


66, 


67 


69, 


71, 


73, 


75, 


77, 


78, 


80, 


81, 


83, 


85 



419 



00 

00 


90 , 91 


. , 92 , 


- 94 , 


96 , 


97 , 9 £ 


99 , 


. 100 


/ 




102 , 


104 , 


106 , 


107 , 


109 , 


110 , 


112 , 


114 , 


115 , 


116 , 


118 , 


119 , 


122 , 


123 , 


125 , 


127 , 


128 , 


130 , 


132 , 


133 , 


135 , 


136 , 


138 , 


140 , 


142 , 


144 , 


146 , 


148 , 


150 , 


152 , 


153 , 


154 , 


156 , 


158 , 


160 , 


161 , 


162 , 


163 , 


164 , 


165 , 


167 , 


168 , 


169 , 


170 , 


172 , 


173 , 


175 , 


181 , 


182 , 


183 , 


184 , 


186 , 


188 , 


189 , 


191 , 


193 , 


194 , 


196 , 


198 , 


199 , 


201 , 


203 , 


204 , 


205 , 


206 , 


207 , 


208 , 


209 , 


211 , 


213 , 


214 , 


216 , 


218 , 


219 , 


221 , 


222 , 


223 , 


225 , 


227 , 


228 , 


229 , 


231 , 


232 , 


233 , 


241 , 


243 , 


244 , 


245 , 


246 , 


248 , 


250 , 


262 , 


264 , 


266 , 


268 , 


270 , 


271 , 


272 , 


273 , 


274 , 


275 , 


276 , 


277 , 


278 , 


279 , 


282 , 


284 , 


296 , 


314 , 


326 , 


338 , 


350 , 


362 , 


364 , 


365 , 


367 , 


369 , 


381 , 


383 , 


402 , 


403 , 


404 , 


405 , 


406 , 


407 , 


408 , 


409 , 


410 , 


411 , 


412 , 


413 , 


414 , 


415 , 


416 , 


417 , 


418 , 


419 , 


431 , 


443 , 


455 , 


467 , 


473 , 


479 , 


480 , 


481 , 


482 , 


484 , 


486 , 


488 , 


489 , 


507 , 


538 , 


539 , 


551 , 


560 , 


562 , 


564 , 


565 , 


567 , 


570 , 


572 , 


574 , 


576 , 


578 , 


593 , 


595 , 


596 , 


597 , 


598 , 


600 , 


602 , 


603 , 


605 , 


606 , 


608 , 


610 , 


612 , 


614 , 


616 , 


618 , 


620 , 


622 , 


623 , 


625 , 


627 , 


629 , 


641 , 


643 , 


644 , 


646 , 


648 , 


650 , 


651 , 


654 , 


656 , 


657 , 


658 , 


664 , 


665 , 


666 , 


667 , 


670 , 


672 , 


673 , 


691 , 


692 , 


693 , 


694 , 


695 , 


696 , 


698 , 


700 , 


702 , 


704 , 


705 , 


706 , 


707 , 


709 , 


721 , 


722 , 


723 , 


724 , 


725 , 


726 , 


738 , 


750 , 


762 , 


774 , 


775 , 


777 , 


779 , 


781 , 


787 , 


820 , 


839 , 


851 , 


863 , 


875 , 


887 , 


899 , 


905 , 


911 , 


912 , 


913 , 


914 , 


915 , 


916 , 


917 , 


918 , 


919 , 


920 , 


922 , 


924 , 


926 , 


927 , 


942 , 


951 , 


957 , 


959 , 


960 , 


962 , 


963 , 


964 , 


965 , 


968 , 


970 , 


972 , 


973 , 


974 , 


976 , 


978 , 


981 , 


993 , 


1005 


, 1006 , 1007 , 1008 , 


1009 , 


1027 , 1046 



1058 , 1059 ) ; 

end Psdl_Shift_Reduce; 
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APPENDIX X. PACKAGE PSDL TOKENS 



with Psdl_Concrete_Type_Pkg; 
use Psdl_Concrete_Type_Pkg; 
package Psdl_Tokens is 



type TOKEN_CATEGORY_TYPE is { INTEGER_LITERAL , 

PSDL_ID_STRING, 

EXPRESSION_STRING, 

TYPE_NAME_STRING, 

TYPE_DECLARATION_STRING, 

TIKE_STRING, 

TIMER_OP_ID_STRING, 

NO_VALUE) ; 

type YYStype ( Token_Category ; TOKEN_CATEGORY_TYPE := NO_VALUE J is 

record 

case Token_Category is 

when INTEGER_LITERAL => 

Integer_Value : INTEGER; 

when PSDL_ID_STRING => 

Psdl_Id_Value : Psdl_Id; 

when TYPE_NAI<E_STRING => 

Type_Name_Value : Type_Name; 

when TYPE_DECLARATION_STRING => 

Type_Declarat ion_Value : Type_Declarati on ; 

when EXPRESSION_STRING => 

Expression_Value : Expression; 

when TIME_STRING => 

Time___Value : Millisec; 

when TIMER_OP_ID_STRING => 

Timer_Op_Id_Value : Timer_Op_Id; 

when NO_VALUE => 

V7hite_Space ; Text := Empty_Text; 
end case; 

end record; 



YYLVal, YYVal : YYSType; 
type Token is 

(End_Of_Input , Error, '{'/ ')'/ 
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Arrow, True, False, 

Ada_Token, Axioms_Token , By_All_Token , 

By_Req_Token , By_Some_Token , Call_Period_Token, 
Control_Token , Cons traint s_Token, Data_Token, 

Descr iption_Token , Edge_Token, End_Token, 
Exceptions_Token, Exception^Token , Execution_Token, 
Finish_Token , Generic_Token , Graph_Token, 

Hours_Token, If_Token, Implementation_Token, 

I nitially_Token , Input_Token, Keywords_Token, 
Maximum_Token, Minimum_Token , Microsec_Token, 
Min_Token, Ms_Token, Mod_Token, 

Not_Token, Operat or_Token , Or_Token, 

Output_Token, Period_Token , Reset_Token, 

Response_Token , Sec_Token, Specif ication_Token, 
Start_Token, States_Token , Stop_Token, 

Stream_Token, Time_Token, Timer_Token, 

Triggered_Token , Type_Token, Vertex_Token , 

Within_Token , Identifier, Integer _Literal , 
Real_Literal, String_Literal , Text_Token, 

And_Token, Xor_Token, Logical_Operator, 

^ f t 

Greater_Than_Or_Equal , Le ss_Than_Or_Equal , Inequality, 
Relat ional_Operator , ' + ' , , 

Binary_Adding_Operator , Unary_Adding_Operator, 
Rem_Token, 

Multiplying_Operator, Exp_Token, Abs_Token, 
Highest_Precedence_Operator ) ; 

Syntax_Error : exception; 

end Psdl_Tokens; 
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